Merge branch 'v7.0-dev' of github.com:datashield/dsBase into refactor/perf-batch-9

Author: timcadman

R/rBinomDS.R

@@ -15,15 +15,11 @@
 #' by <prob> argument of ds.rBinom - for details see help for ds.rBinom
 #' May be a scalar or a vector allowing the size to vary from
 #' observation to observation.
-#' @return Writes the pseudorandom number vector with the characteristics specified
-#' in the function call as a new serverside vector on the data source on which
-#' it has been called. Also returns key information to the clientside:
-#' the random seed as specified by you in each
-#' source + (if requested) the full 626 length random seed vector this generated in
-#' each source (see info for the argument <return.full.seed.as.set>). It
-#' also returns a vector reporting the length of the pseudorandom vector
-#' created in each source.
+#' @return the vector of pseudorandom numbers from a binomial distribution, which
+#' is written to the serverside as the object named by the <newobj> argument
+#' of ds.rBinom.
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 rBinomDS<-function (n, size = 1, prob = 0.5){
 
@@ -34,13 +30,11 @@ rBinomDS<-function (n, size = 1, prob = 0.5){
 #first convert their names into the corresponding active vectors
 
 	if(is.character(size)){
-	command.text<-size
-	size<-eval(parse(text=command.text), envir = parent.frame())
+	size<-.loadServersideObject(size)
 	}
 
 	if(is.character(prob)){
-	command.text<-prob
-	prob<-eval(parse(text=command.text), envir = parent.frame())
+	prob<-.loadServersideObject(prob)
 	}
 
 	stats::rbinom(n, size=size, prob=prob)

R/rNormDS.R

@@ -20,15 +20,12 @@
 #' have k decimal places. If k = 9, no rounding occurs of native output.
 #' Default=9. Value specified by <force.output.to.k.decimal.places> argument
 #' in ds.rNorm
-#' @return Writes the pseudorandom number vector with the characteristics specified
-#' in the function call as a new serverside vector on the data source on which
-#' it has been called. Also returns key information to the clientside:
-#' the random seed as specified by you in each
-#' source + (if requested) the full 626 length random seed vector this generated in
-#' each source (see info for the argument <return.full.seed.as.set>). It
-#' also returns a vector reporting the length of the pseudorandom vector
-#' created in each source.
+#' @return the numeric vector of pseudorandom numbers from a normal distribution,
+#' rounded to <force.output.to.k.decimal.places> decimal places if that is less
+#' than 9, which is written to the serverside as the object named by the <newobj>
+#' argument of ds.rNorm.
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 rNormDS<-function (n, mean = 0, sd = 1, force.output.to.k.decimal.places=9){
 
@@ -39,13 +36,11 @@ rNormDS<-function (n, mean = 0, sd = 1, force.output.to.k.decimal.places=9){
 #first convert their names into the corresponding active vectors
 
 	if(is.character(mean)){
-	command.text<-mean
-	mean<-eval(parse(text=command.text), envir = parent.frame())
+	mean<-.loadServersideObject(mean)
 	}
 
 	if(is.character(sd)){
-	command.text<-sd
-	sd<-eval(parse(text=command.text), envir = parent.frame())
+	sd<-.loadServersideObject(sd)
 	}
 
 	random.number.vector<-stats::rnorm(n, mean=mean, sd=sd)

R/rPoisDS.R

@@ -11,15 +11,11 @@
 #' distribution used to generate the random counts. Specified directly
 #' by the lambda argument in ds.rPois. May be a scalar or a vector allowing lambda
 #' to vary from observation to observation.
-#' @return Writes the pseudorandom number vector with the characteristics specified
-#' in the function call as a new serverside vector on the data source on which
-#' it has been called. Also returns key information to the clientside:
-#' the random seed as specified by you in each
-#' source + (if requested) the full 626 length random seed vector this generated in
-#' each source (see info for the argument <return.full.seed.as.set>). It
-#' also returns a vector reporting the length of the pseudorandom vector
-#' created in each source.
+#' @return the vector of pseudorandom non-negative integers from a Poisson
+#' distribution, which is written to the serverside as the object named by the
+#' <newobj> argument of ds.rPois.
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 rPoisDS<-function (n, lambda = 1){
 
@@ -30,8 +26,7 @@ rPoisDS<-function (n, lambda = 1){
 #first convert its name into the corresponding active vectors
 
 	if(is.character(lambda)){
-	command.text<-lambda
-	lambda<-eval(parse(text=command.text), envir = parent.frame())
+	lambda<-.loadServersideObject(lambda)
 	}
 
 	stats::rpois(n, lambda=lambda)

R/rUnifDS.R

@@ -20,15 +20,12 @@
 #' have k decimal places. If k = 9, no rounding occurs of native output.
 #' Default=9. Value specified by <force.output.to.k.decimal.places> argument
 #' in ds.rUnif
-#' @return Writes the pseudorandom number vector with the characteristics specified
-#' in the function call as a new serverside vector on the data source on which
-#' it has been called. Also returns key information to the clientside:
-#' the random seed as specified by you in each
-#' source + (if requested) the full 626 length random seed vector this generated in
-#' each source (see info for the argument <return.full.seed.as.set>). It
-#' also returns a vector reporting the length of the pseudorandom vector
-#' created in each source.
+#' @return the numeric vector of pseudorandom numbers from a uniform distribution,
+#' rounded to <force.output.to.k.decimal.places> decimal places if that is less
+#' than 9, which is written to the serverside as the object named by the <newobj>
+#' argument of ds.rUnif.
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 rUnifDS<-function (n, min = 0, max = 1, force.output.to.k.decimal.places=9){
 
@@ -39,13 +36,11 @@ rUnifDS<-function (n, min = 0, max = 1, force.output.to.k.decimal.places=9){
 #first convert their names into the corresponding active vectors
 
 	if(is.character(min)){
-	command.text<-min
-	min<-eval(parse(text=command.text), envir = parent.frame())
+	min<-.loadServersideObject(min)
 	}
 
 	if(is.character(max)){
-	command.text<-max
-	max<-eval(parse(text=command.text), envir = parent.frame())
+	max<-.loadServersideObject(max)
 	}
 
 	random.number.vector<-stats::runif(n, min=min, max=max)

R/sampleDS.R

@@ -30,6 +30,7 @@
 #' 'newobj.sample') which is written to the serverside. For further details see 
 #' help for ds.sample and native R help for sample().
 #' @author Paul Burton, for DataSHIELD Development Team, 15/4/2020
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 sampleDS <- function(x.transmit, size.transmit, replace.transmit=NULL, prob.transmit=NULL){
 
@@ -82,7 +83,7 @@ sampleDS <- function(x.transmit, size.transmit, replace.transmit=NULL, prob.tran
   #Activate <x> and <prob> if they are character strings
   if(is.character(x.transmit))
   {
-      x.active<-eval(parse(text=x.transmit), envir = parent.frame())
+      x.active<-.loadServersideObject(x.transmit)
 
   	if(is.data.frame(x.active)||is.matrix(x.active))
   		{
@@ -152,7 +153,7 @@ sampleDS <- function(x.transmit, size.transmit, replace.transmit=NULL, prob.tran
   prob.active<-NULL
   if(is.character(prob.transmit))
   {
-      prob.active<-eval(parse(text=prob.transmit), envir = parent.frame())
+      prob.active<-.loadServersideObject(prob.transmit)
   }
 
   #Check size <= length(x.active) if replace.transmit==FALSE

R/setSeedDS.R

@@ -32,13 +32,18 @@
 #' .Random.seed on each data source that is the true current state of the
 #' random seed in each source.
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 setSeedDS<-function (seedtext=NULL, kind = NULL, normal.kind = NULL)
 {
     # Check Permissive Privacy Control Level.
     dsBase::checkPermissivePrivacyControlLevel(c('permissive', 'avocado'))
 
-    seed<-eval(parse(text=seedtext), envir = parent.frame())
+    if(is.null(seedtext) || seedtext == "NULL"){
+        seed <- NULL
+    } else {
+        seed <- as.integer(seedtext)
+    }
     set.seed(seed,kind,normal.kind)
     return(list(seed.as.set=.Random.seed))
 }