Merge pull request #464 from datashield/perf-batch-1-v5

Refactor: performance improvement batch 1

Author: timcadman

.Rbuildignore

@@ -12,3 +12,4 @@
 ^\.github$
 ^cran-comments\.md$
 ^pull_request_template$
+PULL_REQUEST_TEMPLATE.md

NAMESPACE

@@ -39,6 +39,7 @@ export(densityGridDS)
 export(dimDS)
 export(dmtC2SDS)
 export(elsplineDS)
+export(expDS)
 export(extractQuantilesDS1)
 export(extractQuantilesDS2)
 export(gamlssDS)
@@ -72,6 +73,7 @@ export(listDS)
 export(listDisclosureSettingsDS)
 export(lmerSLMADS.assign)
 export(lmerSLMADS2)
+export(logDS)
 export(lsDS)
 export(lsplineDS)
 export(matrixDS)

R/absDS.R

@@ -12,12 +12,10 @@
 #' @export
 #'
 absDS <- function(x) {
-  x.var <- eval(parse(text = x), envir = parent.frame())
+  x.var <- .loadServersideObject(x)
+  .checkClass(obj = x.var, obj_name = x, permitted_classes = c("numeric", "integer"))
 
-  # compute the absolute values of x
   out <- abs(x.var)
-
-  # assign the outcome to the data servers
   return(out)
 }
 # ASSIGN FUNCTION

R/asCharacterDS.R

@@ -13,7 +13,7 @@
 #' @export
 #'
 asCharacterDS <- function(x.name) {
-  x <- eval(parse(text = x.name), envir = parent.frame())
+  x <- .loadServersideObject(x.name)
 
   output <- as.character(x)
   return(output)

R/asDataMatrixDS.R

@@ -17,15 +17,9 @@
 #' @author Paul Burton for DataSHIELD Development Team
 #' @export
 asDataMatrixDS <- function(x.name) {
-  if (is.character(x.name)) {
-    x <- eval(parse(text = x.name), envir = parent.frame())
-  } else {
-    studysideMessage <- "ERROR: x.name must be specified as a character string"
-    stop(studysideMessage, call. = FALSE)
-  }
+  x <- .loadServersideObject(x.name)
 
   output <- data.matrix(x)
-
   return(output)
 }
 # ASSIGN FUNCTION

R/asIntegerDS.R

@@ -14,18 +14,10 @@
 #' @export
 #'
 asIntegerDS <- function(x.name){
-
-  if(is.character(x.name)){
-    x <- eval(parse(text=x.name), envir = parent.frame())
-  }else{
-    studysideMessage <- "ERROR: x.name must be specified as a character string"
-    stop(studysideMessage, call. = FALSE)
-  }
+  x <- .loadServersideObject(x.name)
 
   output <- as.integer(as.character(x))
-
   return(output)
-
 }
 # ASSIGN FUNCTION
 # asIntegerDS

R/asListDS.R

@@ -22,24 +22,10 @@
 #' @author Amadou Gaye, Paul Burton for DataSHIELD Development Team
 #' @export
 asListDS <- function (x.name, newobj){
+  x <- .loadServersideObject(x.name)
 
-    newobj.class <- NULL
-    if(is.character(x.name)){
-        active.text<-paste0(newobj,"<-as.list(",x.name,")")
-        eval(parse(text=active.text), envir = parent.frame())
-
-        active.text2<-paste0("class(",newobj,")")
-        assign("newobj.class", eval(parse(text=active.text2), envir = parent.frame()))
-
-    }else{
-        studysideMessage<-"ERROR: x.name must be specified as a character string"
-        stop(studysideMessage, call. = FALSE)
-    }
-
-    return.message<-paste0("New object <",newobj,"> created")
-    object.class.text<-paste0("Class of <",newobj,"> is '",newobj.class,"'")
-
-    return(list(return.message=return.message,class.of.newobj=object.class.text))
+  result <- as.list(x)
+  assign(newobj, result, envir = parent.frame())
 }
-# AGGEGATE FUNCTION
+# AGGREGATE FUNCTION
 # asListDS

R/asLogicalDS.R

@@ -1,32 +1,20 @@
-#' @title Coerces an R object into class numeric
-#' @description this function is based on the native R function \code{as.numeric}
+#' @title Coerces an R object into class logical
+#' @description this function is based on the native R function \code{as.logical}
 #' @details See help for function \code{as.logical} in native R
 #' @param x.name the name of the input object to be coerced to class
-#' numeric. Must be specified in inverted commas. But this argument is
+#' logical. Must be specified in inverted commas. But this argument is
 #' usually specified directly by <x.name> argument of the clientside function
-#' \code{ds.aslogical}
+#' \code{ds.asLogical}
 #' @return the object specified by the <newobj> argument (or its default name
 #' <x.name>.logic) which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asLogical}
 #' @author Amadou Gaye, Paul Burton for DataSHIELD Development Team
 #' @export
 asLogicalDS <- function (x.name){
-
-if(is.character(x.name)){
-	x<-eval(parse(text=x.name), envir = parent.frame())
-
-	}else{
-   studysideMessage<-"ERROR: x.name must be specified as a character string"
-   stop(studysideMessage, call. = FALSE)
-   }
-
-  if(!is.numeric(x)&&!is.integer(x)&&!is.character(x)&&!is.matrix(x)){
-  studysideMessage<-"ERROR: for ds.asLogical function, x.name must specify an input object of class numeric, integer, character or matrix"
-  stop(studysideMessage, call. = FALSE)
-  }
+  x <- .loadServersideObject(x.name)
+  .checkClass(obj = x, obj_name = x.name, permitted_classes = c("numeric", "integer", "character", "matrix"))
 
   output <- as.logical(x)
-
   return(output)
 }
 #ASSIGN FUNCTION

R/asMatrixDS.R

@@ -11,17 +11,9 @@
 #' @author Amadou Gaye, Paul Burton for DataSHIELD Development Team
 #' @export
 asMatrixDS <- function (x.name){
-
-if(is.character(x.name)){
-	x<-eval(parse(text=x.name), envir = parent.frame())
-
-	}else{
-   studysideMessage<-"ERROR: x.name must be specified as a character string"
-   stop(studysideMessage, call. = FALSE)
-   }
+  x <- .loadServersideObject(x.name)
 
   output <- as.matrix(x)
-
   return(output)
 }
 #ASSIGN FUNCTION

R/asNumericDS.R

@@ -14,13 +14,7 @@
 #' @export
 #'
 asNumericDS <- function(x.name){
-
-  if(is.character(x.name)){
-    x <- eval(parse(text=x.name), envir = parent.frame())
-  }else{
-    studysideMessage <- "ERROR: x.name must be specified as a character string"
-    stop(studysideMessage, call. = FALSE)
-  }
+  x <- .loadServersideObject(x.name)
 
   # Check that it doesn't match any non-number
   numbers_only <- function(vec) !grepl("\\D", vec)
@@ -36,7 +30,6 @@ asNumericDS <- function(x.name){
   }
 
   return(output)
-
 }
 # ASSIGN FUNCTION
 # asNumericDS