V7.0 dev

.Rbuildignore

@@ -11,3 +11,5 @@
 ^\.circleci/config\.yml$
 ^\.github$
 ^cran-comments\.md$
+^pull_request_template$
+PULL_REQUEST_TEMPLATE.md

.github/pull_request_template

@@ -0,0 +1,15 @@
+## Description
+[Write a description of the changes you have made]
+
+## Checklist (all items may not apply)
+
+### Refactor
+- [ ] Replace `eval(parse(text = x), envir = parent.frame())` with  `.loadServersideObject()`
+- [ ] Where appropriate, check object class using `.checkClass()
+- [ ] Check whether additional checks are required on the server-side 
+
+### Testing
+- [ ] Writen server-side unit tests for unhappy flow
+- [ ] Run and passed `devtools::test(filter = "smk-|disc|arg")`
+- [ ] Run and passed `devtools::check(args = '--no-tests')` (we run tests separately to skip performance checks)
+- [ ] Run and passed `devtools::build`

DESCRIPTION

@@ -5,7 +5,7 @@ Description: Base 'DataSHIELD' functions for the server side. 'DataSHIELD' is a
     been designed to only share non disclosive summary statistics, with built in automated output
     checking based on statistical disclosure control. With data sites setting the threshold values for
     the automated output checks. For more details, see 'citation("dsBase")'.
-Version: 6.3.4
+Version: 7.0.0.9000
 Authors@R: c(person(given = "Paul",
                     family = "Burton",
                     role = c("aut"),
@@ -71,10 +71,12 @@ Imports:
     gamlss,
     gamlss.dist,
     mice,
-    childsds
+    childsds, 
+    glue
 Suggests:
     spelling,
-    testthat
-RoxygenNote: 7.3.3
+    testthat (>= 3.0.0)
+RoxygenNote: 8.0.0
 Encoding: UTF-8
 Language: en-GB
+Config/testthat/edition: 3

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)
@@ -140,3 +142,5 @@ import(gamlss.dist)
 import(mice)
 importFrom(gamlss.dist,pST3)
 importFrom(gamlss.dist,qST3)
+importFrom(glue,glue)
+importFrom(glue,glue_collapse)

PULL_REQUEST_TEMPLATE.md

@@ -0,0 +1,20 @@
+## Instructions & checklist for PR author
+
+### Description of changes
+[Add descriptions of changes made]
+
+### Refactor instructions
+- [ ] Replaced  `x <- eval(parse(text = x.name), envir = parent.frame())` with `x <- .loadServersideObject(x)`
+- [ ] If necessary, check the class of the object using `.checkClass()`
+
+### Testing instructions
+- [ ] Writen server-side unit tests for unhappy flow
+- [ ] Run `devtools::test(filter = "smk-|disc|arg")` and check it passes
+- [ ] Run `devtools::check(args = '--no-tests')` and check it passes (we run tests separately to skip performance checks)
+- [ ] Run `devtools::build()` and check it builds without errors
+
+## Instructions & checklist for PR reviewers
+- [ ] Run `devtools::test(filter = "smk-|disc|arg")` and check it passes
+- [ ] Run `devtools::check(args = '--no-tests')` and check it passes (we run tests separately to skip performance checks)
+- [ ] Run `devtools::build()` and check it builds without errors
+

R/absDS.R

@@ -9,15 +9,14 @@
 #' which is written to the serverside. The output object is of class numeric
 #' or integer.
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -10,10 +10,11 @@
 #' "ascharacter.newobj") which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asCharacter}
 #' @author Amadou Gaye, Paul Burton, Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -15,17 +15,12 @@
 #' "asdatamatrix.newobj") which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asDataMatrix}
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -11,21 +11,14 @@
 #' "asinteger.newobj") which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asInteger}.
 #' @author Amadou Gaye, Paul Burton, Demetris Avraam, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -20,26 +20,13 @@
 #' coerces objects to list depends on the class of the object, but in general
 #' the class of the output object should usually be 'list'
 #' @author Amadou Gaye, Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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,21 @@
-#' @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
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -9,19 +9,12 @@
 #' <x.name>.mat) which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asMatrix}
 #' @author Amadou Gaye, Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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

@@ -11,16 +11,11 @@
 #' <x.name>.num) which is written to the serverside. For further
 #' details see help on the clientside function \code{ds.asNumeric}.
 #' @author Amadou Gaye, Paul Burton, Demetris Avraam, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @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 +31,6 @@ asNumericDS <- function(x.name){
   }
 
   return(output)
-
 }
 # ASSIGN FUNCTION
 # asNumericDS

R/classDS.R

@@ -5,18 +5,13 @@
 #' @param x a string character, the name of an object
 #' @return the class of the input object
 #' @author Stuart Wheater, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 classDS <- function(x){
-
-  x.val <- eval(parse(text=x), envir = parent.frame())
-
-  # find the class of the input object
+  x.val <- .loadServersideObject(x)
   out <- class(x.val)
-
-  # return the class
   return(out)
-
 }
 #AGGREGATE FUNCTION
 # classDS

R/colnamesDS.R

@@ -8,15 +8,10 @@
 #' @export
 #'
 colnamesDS <- function(x){
-
-  x.val <- eval(parse(text=x), envir = parent.frame())
-
-  # find the dim of the input dataframe or matrix
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("data.frame", "matrix"))
   out <- colnames(x.val)
-
-  # return the dimension
   return(out)
-
 }
 #AGGREGATE FUNCTION
 # colnamesDS

R/completeCasesDS.R

@@ -31,6 +31,7 @@
 #' without problems no studysideMessage will have been saved and ds.message("newobj")
 #' will return the message: "ALL OK: there are no studysideMessage(s) on this datasource".
 #' @author Paul Burton for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' 
 completeCasesDS <- function(x1.transmit){
@@ -111,10 +112,9 @@ completeCasesDS <- function(x1.transmit){
   }
 
   #Activate target object
-  #x1.transmit is the name of a serverside data.frame, matrix or vector
-  x1.use <- eval(parse(text=x1.transmit), envir = parent.frame())
+  x1.use <- .loadServersideObject(x1.transmit)
   complete.rows <- stats::complete.cases(x1.use)
-  
+
   if(is.matrix(x1.use) || is.data.frame(x1.use)){
     output.object <- x1.use[complete.rows,]
   }else if(is.atomic(x1.use) || is.factor(x1.use)){

R/dimDS.R

@@ -3,20 +3,16 @@
 #' @description This function is similar to R function \code{dim}.
 #' @details The function returns the dimension of the input dataframe or matrix
 #' @param x a string character, the name of a dataframe or matrix
-#' @return the dimension of the input object
+#' @return a list with two elements: \code{dim} (the dimension of the input object)
+#'   and \code{class} (the class of the input object, for client-side consistency checking)
 #' @author Demetris Avraam, for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #'
 dimDS <- function(x){
-
-  x.var <- eval(parse(text=x), envir = parent.frame())
-
-  # find the dim of the input dataframe or matrix
-  out <- dim(x.var)
-
-  # return the dimension
-  return(out)
-
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("data.frame", "matrix"))
+  list(dim = dim(x.val), class = class(x.val))
 }
 #AGGREGATE FUNCTION
 # dimDS

R/expDS.R

@@ -0,0 +1,22 @@
+#'
+#' @title Computes the exponential values of the input variable
+#' @description This function is similar to R function \code{exp}.
+#' @details The function computes the exponential values of an input numeric
+#' or integer vector.
+#' @param x a string character, the name of a numeric or integer vector
+#' @return the object specified by the \code{newobj} argument
+#' of \code{ds.exp} (or default name \code{exp.newobj})
+#' which is written to the serverside. The output object is of class numeric.
+#' @author DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
+#' @export
+#'
+expDS <- function(x) {
+  x.var <- .loadServersideObject(x)
+  .checkClass(obj = x.var, obj_name = x, permitted_classes = c("numeric", "integer"))
+
+  out <- exp(x.var)
+  return(out)
+}
+# ASSIGN FUNCTION
+# expDS