Refactor/perf batch 2

DESCRIPTION

@@ -62,14 +62,16 @@ Depends:
     R (>= 4.0.0),
     DSI (>= 1.7.1)
 Imports:
+    cli,
     fields,
     metafor,
     meta,
     ggplot2,
     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/checkClass.R

@@ -13,7 +13,7 @@
 checkClass <- function(datasources=NULL, obj=NULL){
   # check the class of the input object
   cally <- call("classDS", obj)
-  classesBy <- DSI::datashield.aggregate(datasources, cally, async = FALSE)
+  classesBy <- DSI::datashield.aggregate(datasources, cally)
   classes <- unique(unlist(classesBy))
   for (n in names(classesBy)) {
     if (!all(classes == classesBy[[n]])) {

R/ds.abs.R

@@ -17,6 +17,7 @@
 #' the input numeric or integer vector specified in the argument \code{x}. The created vectors
 #' are stored in the servers.
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' @examples
 #' \dontrun{
@@ -72,41 +73,17 @@
 #'
 ds.abs <- function(x=NULL, 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)
 
   if(is.null(x)){
     stop("Please provide the name of the input object!", call.=FALSE)
   }
 
-  # check if the input object is defined in all the studies
-  isDefined(datasources, x)
-
-  # call the internal function that checks the input object is of the same class in all studies.
-  typ <- checkClass(datasources, x)
-
-  # call the internal function that checks the input object(s) is(are) of the same class in all studies.
-  if(!('numeric' %in% typ) && !('integer' %in% typ)){
-    stop("Only objects of type 'numeric' or 'integer' are allowed.", call.=FALSE)
-  }
-
-  # create a name by default if the user did not provide a name for the new variable
   if(is.null(newobj)){
     newobj <- "abs.newobj"
   }
 
-  # call the server side function that does the operation
   cally <- call("absDS", x)
   DSI::datashield.assign(datasources, newobj, cally)
 
-  # check that the new object has been created and display a message accordingly
-  finalcheck <- isAssigned(datasources, newobj)
-
 }

R/ds.asCharacter.R

@@ -13,9 +13,7 @@
 #' 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.asCharacter} returns the object converted into a class character 
-#' that 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.
+#' that is written to the server-side.
 #' @examples 
 #' \dontrun{
 #'   ## Version 6, for version 5 see the Wiki
@@ -53,115 +51,22 @@
 #'   
 #' }   
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' 
 ds.asCharacter <- function(x.name=NULL, 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)
 
   if(is.null(x.name)){
     stop("Please provide the name of the input vector!", call.=FALSE)
   }
 
-  # check if the input object is defined in all the studies
-  isDefined(datasources, x.name)
-
-  # create a name by default if user did not provide a name for the new variable
   if(is.null(newobj)){
     newobj <- "ascharacter.newobj"
   }
 
-    # call the server side function that does the job
-
 	calltext <- call("asCharacterDS", x.name)
-
 	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																					 	#
-																											#																											#
-																											#
-# 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.asCharacter

R/ds.asDataMatrix.R

@@ -12,11 +12,7 @@
 #' 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.asDataMatrix} returns the object converted into a matrix 
-#' that 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.
+#' that is written to the server-side.
 #' @examples 
 #' \dontrun{
 #'   ## Version 6, for version 5 see the Wiki
@@ -54,113 +50,22 @@
 #'   
 #' }   
 #' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' 
 ds.asDataMatrix <- function(x.name=NULL, 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)
 
   if(is.null(x.name)){
     stop("Please provide the name of the input vector!", call.=FALSE)
   }
 
-  # check if the input object is defined in all the studies
-  isDefined(datasources, x.name)
-
-  # create a name by default if user did not provide a name for the new variable
   if(is.null(newobj)){
     newobj <- "asdatamatrix.newobj"
   }
 
-  # call the server side function that does the job
 	calltext <- call("asDataMatrixDS", x.name)
 	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																					 	#
-																											#																											#
-																											#
-# 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.asDataMatrix