refactor: move checks to serverside

Author: timcadman

R/corDS.R

@@ -27,9 +27,12 @@ corDS <- function(x=NULL, y=NULL){
   nfilter.glm <- as.numeric(thr$nfilter.glm)
   #############################################################
 
-  x.val <- eval(parse(text=x), envir = parent.frame())
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer", "matrix", "data.frame"))
+
   if (!is.null(y)){
-    y.val <- eval(parse(text=y), envir = parent.frame())
+    y.val <- .loadServersideObject(y)
+    .checkClass(obj = y.val, obj_name = y, permitted_classes = c("numeric", "integer", "matrix", "data.frame"))
   }
   else{
     y.val <- NULL

R/corTestDS.R

@@ -17,8 +17,10 @@
 #'
 corTestDS <- function(x, y, method, exact, conf.level){
 
-  x.var <- eval(parse(text=x), envir = parent.frame())
-  y.var <- eval(parse(text=y), envir = parent.frame())
+  x.var <- .loadServersideObject(x)
+  .checkClass(obj = x.var, obj_name = x, permitted_classes = c("numeric", "integer"))
+  y.var <- .loadServersideObject(y)
+  .checkClass(obj = y.var, obj_name = y, permitted_classes = c("numeric", "integer"))
 
   # get the number of pairwise complete cases
   n <- sum(stats::complete.cases(x.var, y.var))

R/covDS.R

@@ -36,9 +36,12 @@ covDS <- function(x=NULL, y=NULL, use=NULL){
   #nfilter.string <- as.numeric(thr$nfilter.string)
   #############################################################
 
-  x.val <- eval(parse(text=x), envir = parent.frame())
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer", "matrix", "data.frame"))
+
   if (!is.null(y)){
-    y.val <- eval(parse(text=y), envir = parent.frame())
+    y.val <- .loadServersideObject(y)
+    .checkClass(obj = y.val, obj_name = y, permitted_classes = c("numeric", "integer", "matrix", "data.frame"))
   }
   else{
     y.val <- NULL

R/kurtosisDS1.R

@@ -19,8 +19,9 @@ kurtosisDS1 <- function (x, method){
   nfilter.tab <- as.numeric(thr$nfilter.tab)
   #############################################################
 
-  x <- eval(parse(text=x), envir = parent.frame())
-  x <- x[stats::complete.cases(x)]
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer"))
+  x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
     kurtosis.out <- NA

R/kurtosisDS2.R

@@ -23,8 +23,9 @@ kurtosisDS2 <- function(x, global.mean){
   nfilter.tab <- as.numeric(thr$nfilter.tab)
   #############################################################
 
-  x <- eval(parse(text=x), envir = parent.frame())
-  x <- x[stats::complete.cases(x)]
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer"))
+  x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
     sum_quartics.out <- NA

R/meanDS.R

@@ -3,12 +3,12 @@
 #' @description Calculates the mean value.
 #' @details if the length of input vector is less than the set filter
 #' a missing value is returned.
-#' @param xvect a vector
+#' @param x a character string, the name of a numeric or integer vector
 #' @return a numeric, the statistical mean
 #' @author Gaye A, Burton PR
 #' @export
 #'
-meanDS <- function(xvect){
+meanDS <- function(x){
 
   #############################################################
   # MODULE 1: CAPTURE THE nfilter SETTINGS
@@ -19,6 +19,9 @@ meanDS <- function(xvect){
   #nfilter.string <- as.numeric(thr$nfilter.string)
   #############################################################
 
+  xvect <- .loadServersideObject(x)
+  .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer"))
+
   out.mean <- mean(xvect, na.rm=TRUE)
   out.numNa <- length(which(is.na(xvect)))
   out.totN <- length(xvect)

R/meanSdGpDS.R

@@ -3,17 +3,17 @@
 #' @description Server-side function called by ds.meanSdGp 
 #' @details Computes the mean and standard deviation across groups defined by one
 #' factor
-#' @param X a client-side supplied character string identifying the variable for which
+#' @param x a client-side supplied character string identifying the variable for which
 #' means/SDs are to be calculated
-#' @param INDEX a client-side supplied character string identifying the factor across
+#' @param index a client-side supplied character string identifying the factor across
 #' which means/SDs are to be calculated
 #' @author Burton PR
-#' 
+#'
 #' @return List with results from the group statistics
 #' @export
 #'
-meanSdGpDS <- function (X, INDEX){
-  
+meanSdGpDS <- function (x, index){
+
   #############################################################
   # MODULE 1: CAPTURE THE nfilter SETTINGS
   thr <- dsBase::listDisclosureSettingsDS()
@@ -23,9 +23,14 @@ meanSdGpDS <- function (X, INDEX){
   #nfilter.string <- as.numeric(thr$nfilter.string)
   #############################################################
 
+  X <- .loadServersideObject(x)
+  .checkClass(obj = X, obj_name = x, permitted_classes = c("numeric", "integer"))
+  INDEX <- .loadServersideObject(index)
+  .checkClass(obj = INDEX, obj_name = index, permitted_classes = c("factor", "character", "integer"))
+
   FUN.mean <- function(x) {mean(x,na.rm=TRUE)}
   FUN.var <- function(x)  {stats::var(x,na.rm=TRUE)}
-  
+
   #Strip missings from both X and INDEX
   analysis.matrix<-cbind(X,INDEX)
 

R/quantileMeanDS.R

@@ -2,18 +2,21 @@
 #' @title Generates quantiles and mean information without maximum and minimum
 #' @description the probabilities 5%, 10%, 25%, 50%, 75%, 90%, 95% and the mean
 #' are used to compute the corresponding quantiles.
-#' @param xvect a numerical vector
-#' @return a numeric vector that represents the sample quantiles 
+#' @param x a character string, the name of a numeric or integer vector
+#' @return a numeric vector that represents the sample quantiles
 #' @export
 #' @author Burton, P.; Gaye, A.
-#' 
-quantileMeanDS <- function (xvect) {
-  
+#'
+quantileMeanDS <- function (x) {
+
+  xvect <- .loadServersideObject(x)
+  .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer"))
+
   # check if the input vector is valid (i.e. meets DataSHIELD criteria)
   check <- isValidDS(xvect)
-  
+
   if(check){
-    # if the input vector is valid 
+    # if the input vector is valid
     qq <- stats::quantile(xvect,c(0.05,0.1,0.25,0.5,0.75,0.9,0.95), na.rm=TRUE)
     mm <- mean(xvect,na.rm=TRUE)
     quantile.obj <- c(qq, mm)

R/skewnessDS1.R

@@ -19,8 +19,9 @@ skewnessDS1 <- function(x, method){
   nfilter.tab <- as.numeric(thr$nfilter.tab)
   #############################################################
 
-  x <- eval(parse(text=x), envir = parent.frame())
-  x <- x[stats::complete.cases(x)]
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer"))
+  x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
     skewness.out <- NA

R/skewnessDS2.R

@@ -23,8 +23,9 @@ skewnessDS2 <- function(x, global.mean){
   nfilter.tab <- as.numeric(thr$nfilter.tab)
   #############################################################
 
-  x <- eval(parse(text=x), envir = parent.frame())
-  x <- x[stats::complete.cases(x)]
+  x.val <- .loadServersideObject(x)
+  .checkClass(obj = x.val, obj_name = x, permitted_classes = c("numeric", "integer"))
+  x <- x.val[stats::complete.cases(x.val)]
 
   if(length(x) < nfilter.tab){
     sum_cubes.out <- NA