Refactor/perf batch 4

.Rbuildignore

@@ -23,3 +23,4 @@
 ^\.circleci$
 ^\.circleci/config\.yml$
 ^\.github$
+^REFACTOR_GUIDE\.md$

DESCRIPTION

@@ -69,7 +69,8 @@ Imports:
     gridExtra,
     data.table,
     methods,
-    dplyr
+    dplyr,
+    cli
 Suggests:
     lme4,
     httr,

NAMESPACE

@@ -119,6 +119,8 @@ export(ds.var)
 export(ds.vectorCalc)
 import(DSI)
 import(data.table)
+importFrom(DSI,datashield.connections_find)
+importFrom(cli,cli_abort)
 importFrom(stats,as.formula)
 importFrom(stats,na.omit)
 importFrom(stats,ts)

R/ds.Boole.R

@@ -37,11 +37,8 @@
 #' @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}}.
-#' @return \code{ds.Boole} returns the object specified by the \code{newobj} argument 
-#' which is written to the server-side. Also, two validity messages are returned
-#' to the client-side indicating the name of the \code{newobj} which 
-#' has been created in each data source and if 
-#' it is in a valid form.
+#' @return \code{ds.Boole} returns the object specified by the \code{newobj} argument
+#' which is written to the server-side.
 #' @examples 
 #' 
 #' \dontrun{
@@ -102,19 +99,12 @@
 #' }
 #'  
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 ds.Boole<-function(V1=NULL, V2=NULL, Boolean.operator=NULL, numeric.output=TRUE, na.assign="NA",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 column or scalar that holds V1
   if(is.null(V1)){
@@ -178,88 +168,8 @@ ds.Boole<-function(V1=NULL, V2=NULL, Boolean.operator=NULL, numeric.output=TRUE,
   }
 
   # CALL THE MAIN SERVER SIDE FUNCTION
-  calltext <- call("BooleDS", V1, V2, BO.n, na.assign,numeric.output)
+  calltext <- call("BooleDS", V1, V2, BO.n, na.assign, numeric.output)
   DSI::datashield.assign(datasources, newobj, calltext)
 
-#############################################################################################################
-#DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED                                  #
-																											#
-#SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION                                                 	#
-test.obj.name<-newobj																					 	#
-																											#
-#TRACER																									 	#
-#return(test.obj.name)																					 	#
-#}                                                                                   					 	#
-																											#
-																											#
-# CALL SEVERSIDE FUNCTION                                                                                	#
-calltext <- call("testObjExistsDS", test.obj.name)													 	#
-																											#
-object.info<-DSI::datashield.aggregate(datasources, calltext)												 	#
-																											#
-# CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS														 	#
-# AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS											 	#
-num.datasources<-length(object.info)																	 	#
-																											#
-																											#
-obj.name.exists.in.all.sources<-TRUE																	 	#
-obj.non.null.in.all.sources<-TRUE																		 	#
-																											#
-for(j in 1:num.datasources){																			 	#
-	if(!object.info[[j]]$test.obj.exists){																 	#
-		obj.name.exists.in.all.sources<-FALSE															 	#
-		}																								 	#
-	if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){														 	#
-		obj.non.null.in.all.sources<-FALSE																 	#
-		}																								 	#
-	}																									 	#
-																											#
-if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){										 	#
-																											#
-	return.message<-																					 	#
-    paste0("A data object <", test.obj.name, "> has been created in all specified data sources")		 	#
-																											#
-																											#
-	}else{																								 	#
-																											#
-    return.message.1<-																					 	#
-	paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources")	#
-																											#
-	return.message.2<-																					 	#
-	paste0("It is either ABSENT and/or has no valid content/class,see return.info above")				 	#
-																											#
-	return.message.3<-																					 	#
-	paste0("Please use ds.ls() to identify where missing")												 	#
-																											#
-																											#
-	return.message<-list(return.message.1,return.message.2,return.message.3)							 	#
-																											#
-	}																										#
-																											#
-	calltext <- call("messageDS", test.obj.name)															#
-    studyside.message<-DSI::datashield.aggregate(datasources, calltext)											#
-																											#
-	no.errors<-TRUE																							#
-	for(nd in 1:num.datasources){																			#
-		if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){			#
-		no.errors<-FALSE																					#
-		}																									#
-	}																										#
-																											#
-																											#
-	if(no.errors){																							#
-	validity.check<-paste0("<",test.obj.name, "> appears valid in all sources")							    #
-	return(list(is.object.created=return.message,validity.check=validity.check))						    #
-	}																										#
-																											#
-if(!no.errors){																								#
-	validity.check<-paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:")   #
-	return(list(is.object.created=return.message,validity.check=validity.check,					    		#
-	            studyside.messages=studyside.message))			                                            #
-	}																										#
-																											#
-#END OF CHECK OBJECT CREATED CORECTLY MODULE															 	#
-#############################################################################################################
-
 }
 #ds.Boole

R/ds.c.R

@@ -10,7 +10,9 @@
 #' @param x  a vector of character string providing the names of the objects to be combined.
 #' @param newobj a character string that provides the name for the output object 
 #' that is stored on the data servers. Default \code{c.newobj}.
-#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} 
+#' @param classConsistencyCheck logical. If TRUE, verifies that each input object has
+#' the same class across all studies before concatenation. Default TRUE.
+#' @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}}.
 #' @return  \code{ds.c} returns the vector of concatenating R
@@ -53,19 +55,12 @@
 #'   
 #' }    
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
-#' 
-ds.c <- function(x=NULL, newobj=NULL, datasources=NULL){
+#'
+ds.c <- function(x=NULL, newobj=NULL, 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("x=NULL. Please provide the names of the objects to concatenate!", call.=FALSE)
@@ -76,19 +71,14 @@ ds.c <- function(x=NULL, newobj=NULL, datasources=NULL){
     newobj <- "c.newobj"
   }
 
-  # check if the input object(s) is(are) defined in all the studies
-  lapply(x, function(k){isDefined(datasources, obj=k)})
-
-  # call the internal function that checks the input object(s) is(are) of the same class in all studies.
-  for(i in 1:length(x)){
-    typ <- checkClass(datasources, x[i])
+  if(classConsistencyCheck){
+    for(i in seq_along(x)){
+      checkClass(datasources, x[i])
+    }
   }
 
   # call the server side function that does the job
-  cally <-  paste0("cDS(list(",paste(x,collapse=","),"))")
-  DSI::datashield.assign(datasources, newobj, as.symbol(cally))
-
-  # check that the new object has been created and display a message accordingly
-  finalcheck <- isAssigned(datasources, newobj)
+  cally <- call("cDS", x)
+  DSI::datashield.assign(datasources, newobj, cally)
 
 }

R/ds.cbind.R

@@ -30,17 +30,16 @@
 #' @param force.colnames can be NULL (recommended) or a vector of characters that specifies 
 #' column names of the output object. If it is not NULL the user should take some caution. 
 #' For more information see \strong{Details}.
-#' @param newobj a character string that provides the name for the output variable 
-#' that is stored on the data servers. Defaults \code{cbind.newobj}. 
-#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} objects obtained after login. 
+#' @param classConsistencyCheck logical. If TRUE, verifies that each input object has the same class across all studies. Default TRUE.
+#' @param newobj a character string that provides the name for the output variable
+#' that is stored on the data servers. Defaults \code{cbind.newobj}.
+#' @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}}.
 #' @param notify.of.progress specifies if console output should be produced to indicate
 #' progress. Default FALSE.
-#' @return \code{ds.cbind} returns a data frame combining the columns of the R 
-#' objects specified in the function which is written to the server-side. 
-#' It also returns to the client-side two messages with the name of \code{newobj}
-#' that has been created in each data source and \code{DataSHIELD.checks} result. 
+#' @return \code{ds.cbind} returns a data frame combining the columns of the R
+#' objects specified in the function which is written to the server-side.
 #' @examples 
 #' 
 #' \dontrun{
@@ -113,37 +112,29 @@
 #'   }
 #' 
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
-#' 
-ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newobj=NULL, datasources=NULL, notify.of.progress=FALSE){
-
-  # look for DS connections
-  if(is.null(datasources)){
-    datasources <- datashield.connections_find()
-  }
+#'
+ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newobj=NULL, datasources=NULL, notify.of.progress=FALSE, classConsistencyCheck=TRUE){
 
-  # 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 a vector of character strings holding the name of the input elements!", call.=FALSE)
   }
 
   if(DataSHIELD.checks){
-
-    # check if the input object(s) is(are) defined in all the studies
-    lapply(x, function(k){isDefined(datasources, obj=k)})
-
+
     # call the internal function that checks the input object(s) is(are) of the same legal class in all studies.
+    if(classConsistencyCheck){
     for(i in 1:length(x)){
       typ <- checkClass(datasources, x[i])
       if(!('data.frame' %in% typ) & !('matrix' %in% typ) & !('factor' %in% typ) & !('character' %in% typ) & !('numeric' %in% typ) & !('integer' %in% typ) & !('logical' %in% typ)){
         stop("Only objects of type 'data.frame', 'matrix', 'numeric', 'integer', 'character', 'factor' and 'logical' are allowed.", call.=FALSE)
       }
     }
-
+    }
+
     # check that there are no duplicated column names in the input components
     for(j in 1:length(datasources)){
       colNames <- list()
@@ -158,10 +149,10 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob
         colNames <- unlist(colNames)
         if(anyDuplicated(colNames) != 0){
           message("\n Warning: Some column names in study", j, "are duplicated and a suffix '.k' will be added to the kth replicate \n")
-        }  
-      }  
-    } 
-    
+        }
+      }
+    }
+
     # check that the number of rows is the same in all componets to be cbind
     for(j in 1:length(datasources)){
       nrows <- list()
@@ -178,8 +169,8 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob
       if(any(nrows != nrows[1])){
         stop("The number of rows is not the same in all of the components to be cbind", call.=FALSE)
       }
-    }  
-    
+    }
+
   }
 
   # check newobj not actively declared as null
@@ -238,63 +229,6 @@ ds.cbind <- function(x=NULL, DataSHIELD.checks=FALSE, force.colnames=NULL, newob
     DSI::datashield.assign(datasources[std], newobj, calltext)
   }
 
-  #############################################################################################################
-  # DataSHIELD CLIENTSIDE MODULE: CHECK KEY DATA OBJECTS SUCCESSFULLY CREATED  
-
-  # SET APPROPRIATE PARAMETERS FOR THIS PARTICULAR FUNCTION 
-  test.obj.name <- newobj	
-
-  # CALL SEVERSIDE FUNCTION
-  calltext <- call("testObjExistsDS", test.obj.name)
-  object.info <- DSI::datashield.aggregate(datasources, calltext)
-
-  # CHECK IN EACH SOURCE WHETHER OBJECT NAME EXISTS
-  # AND WHETHER OBJECT PHYSICALLY EXISTS WITH A NON-NULL CLASS
-  num.datasources <- length(object.info)
-
-  obj.name.exists.in.all.sources <- TRUE
-  obj.non.null.in.all.sources <- TRUE
-
-  for(j in 1:num.datasources){
-  	if(!object.info[[j]]$test.obj.exists){
-  		obj.name.exists.in.all.sources <- FALSE
-  	}
-  	if(is.null(object.info[[j]]$test.obj.class) || ("ABSENT" %in% object.info[[j]]$test.obj.class)){
-  		obj.non.null.in.all.sources <- FALSE
-  	}
-  }
-
-  if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){
-		return.message <- paste0("A data object <", test.obj.name, "> has been created in all specified data sources")
-	}else{
-    return.message.1 <- paste0("Error: A valid data object <", test.obj.name, "> does NOT exist in ALL specified data sources")
-  	return.message.2 <- paste0("It is either ABSENT and/or has no valid content/class,see return.info above")	
-  	return.message.3 <-	paste0("Please use ds.ls() to identify where missing")
-  	return.message <- list(return.message.1,return.message.2,return.message.3)
-	}
-
-	calltext <- call("messageDS", test.obj.name)
-  studyside.message <- DSI::datashield.aggregate(datasources, calltext)
-	no.errors <- TRUE
-	for(nd in 1:num.datasources){
-		if(studyside.message[[nd]]!="ALL OK: there are no studysideMessage(s) on this datasource"){
-		no.errors <- FALSE
-		}
-	}
-
-	if(no.errors){
-	  validity.check <- paste0("<",test.obj.name, "> appears valid in all sources")
-	  return(list(is.object.created=return.message,validity.check=validity.check))
-	}
-
-  if(!no.errors){
-	  validity.check <- paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:")
-	  return(list(is.object.created=return.message,validity.check=validity.check,
-	            studyside.messages=studyside.message))
-  }
-
-  # END OF CHECK OBJECT CREATED CORECTLY MODULE	
-  #######################################################################################################
 
 }
 #ds.cbind