Refactor/perf batch 9

R/boxPlotGGDS.R

@@ -5,7 +5,7 @@
 #' parameters are passed. There are three different cases depending if there are grouping variables. 
 #' The outliers are also removed from the graphical parameters.
 #'
-#' @param data_table \code{data frame} Table that holds the information to be plotted, arranged as: \cr
+#' @param data_table.name \code{character} Name of a server-side data frame that holds the information to be plotted, arranged as: \cr
 #' 
 #'  Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr
 #'  Column 'value': Values for that variable (raw data of columns rbinded) \cr
@@ -18,11 +18,14 @@
 #' @return \code{list} with: \cr
 #' -\code{data frame} Geometrical parameters (identity stats of ggplot) \cr
 #' -\code{character} Type of plot (single_group, double_group or no_group) \cr
-#' 
+#'
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 
-boxPlotGGDS <- function(data_table, group = NULL, group2 = NULL){
-
+boxPlotGGDS <- function(data_table.name, group = NULL, group2 = NULL){
+
+  data_table <- .loadServersideObject(data_table.name)
+
   ###################################################################
   # MODULE 1: CAPTURE THE subset filter SETTINGS                    #
   thr <- dsBase::listDisclosureSettingsDS()                         #

R/boxPlotGG_data_TreatmentDS.R

@@ -1,42 +1,46 @@
 #' @title Arrange data frame to pass it to the boxplot function
 #'
-#' @param table \code{data frame} Table that holds the information to be plotted later
+#' @param table.name \code{character} Name of a server-side data frame that holds the information to be plotted later
 #' @param variables \code{character vector} Name of the column(s) of the data frame to include on the boxplot
-#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable. 
-#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable. 
+#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable.
+#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable.
 #'
 #' @return \code{data frame} with the following structure: \cr
-#' 
+#'
 #'  Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr
 #'  Column 'value': Values for that variable (raw data of columns rbinded) \cr
 #'  Column 'group': (Optional) Values of the grouping variable \cr
 #'  Column 'group2': (Optional) Values of the second grouping variable \cr
-#'  
+#'
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 
-boxPlotGG_data_TreatmentDS <- function(table, variables, group = NULL, group2 = NULL){
+boxPlotGG_data_TreatmentDS <- function(table.name, variables, group = NULL, group2 = NULL){
+
+  table <- .loadServersideObject(table.name)
+
+  for(variable in variables){
+    .checkClass(obj = table[[variable]], obj_name = variable, permitted_classes = c("numeric", "integer"))
+  }
 
   if(is.null(group) & !is.null(group2)){
     group <- group2
     group2 <- NULL
   }
-  
+
   if(is.null(group2)){
     if(is.null(group)){
       data <- table[, c(variables)]
     }
     else{
-      if(! any(c("factor") %in% class(table[[group]]))) {
-        stop("Grouping variable must be of class factor")
-      }
+      .checkClass(obj = table[[group]], obj_name = group, permitted_classes = c("factor"))
       data <- table[, c(variables, group)]
     }
-    
+
   }
   else{
-    if((! any(c("factor") %in% class(table[[group]]))) | (! any(c("factor") %in% class(table[[group2]])))){
-      stop("Grouping variable must be of class factor")
-    }
+    .checkClass(obj = table[[group]], obj_name = group, permitted_classes = c("factor"))
+    .checkClass(obj = table[[group2]], obj_name = group2, permitted_classes = c("factor"))
     data <- table[, c(variables, group, group2)]
     # Handle case group == group2 
     if(group == group2){

R/boxPlotGG_data_Treatment_numericDS.R

@@ -1,18 +1,22 @@
 #' @title Arrange vector to pass it to the boxplot function
 #'
-#' @param vector \code{numeric vector} Vector to arrange to be plotted later
+#' @param vector.name \code{character} Name of a server-side numeric vector to arrange to be plotted later
 #'
 #' @return \code{data frame} with the following structure: \cr
-#' 
-#'  Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr
+#'
+#'  Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector.name argument) \cr
 #'  Column 'value': Values for that variable \cr
-#'  
+#'
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 
-boxPlotGG_data_Treatment_numericDS <- function(vector){
-
-  data <- data.frame(x = deparse(substitute(vector)), value = vector)
-
+boxPlotGG_data_Treatment_numericDS <- function(vector.name){
+
+  vector <- .loadServersideObject(vector.name)
+  .checkClass(obj = vector, obj_name = vector.name, permitted_classes = c("numeric", "integer"))
+
+  data <- data.frame(x = vector.name, value = vector)
+
   return(data)
-  
+
 }

R/densityGridDS.R

@@ -3,24 +3,31 @@
 #' @description Generates a density grid that can then be used for heatmap or contour plots.
 #' @details Invalid cells (cells with count < to the set filter value for the minimum allowed
 #' counts in table cells) are turn to 0.
-#' @param xvect a numerical vector
-#' @param yvect a numerical vector
+#' @param x a character string providing the name of a server-side numerical vector
+#' @param y a character string providing the name of a server-side numerical vector
 #' @param limits a logical expression for whether or not limits of the density grid are defined by
-#' a user. If \code{limits} is set to "FALSE", min and max of xvect and yvect are used as a range.
+#' a user. If \code{limits} is set to "FALSE", min and max of x and y are used as a range.
 #' If \code{limits} is set to "TRUE", limits defined by x.min, x.max, y.min and y.max are used.
 #' @param x.min a minimum value for the x axis of the grid density object, if needed
 #' @param x.max a maximum value for the x axis of the grid density object, if needed
 #' @param y.min a minimum value for the y axis of the grid density object, if needed
 #' @param y.max a maximum value for the y axis of the grid density object, if needed
 #' @param numints a number of intervals for the grid density object, by default is 20
-#' @return a grid density matrix
+#' @return a list with the grid density matrix (\code{grid}) and the classes of the x and y inputs
+#' (\code{class.x} and \code{class.y})
 #' @author Julia Isaeva, Amadou Gaye, Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
-#' 
-densityGridDS  <- function(xvect, yvect, limits=FALSE, x.min=NULL, x.max=NULL, y.min=NULL, y.max=NULL, numints=20){
-
+#'
+densityGridDS  <- function(x, y, limits=FALSE, x.min=NULL, x.max=NULL, y.min=NULL, y.max=NULL, numints=20){
+
+  xvect <- .loadServersideObject(x)
+  yvect <- .loadServersideObject(y)
+  .checkClass(obj = xvect, obj_name = x, permitted_classes = c("numeric", "integer"))
+  .checkClass(obj = yvect, obj_name = y, permitted_classes = c("numeric", "integer"))
+
   #############################################################
-  # MODULE 1: CAPTURE THE nfilter SETTINGS                    
+  # MODULE 1: CAPTURE THE nfilter SETTINGS
   thr <- dsBase::listDisclosureSettingsDS()				
   nfilter.tab <- as.numeric(thr$nfilter.tab)					
   #nfilter.glm <- as.numeric(thr$nfilter.glm)					
@@ -93,9 +100,9 @@ densityGridDS  <- function(xvect, yvect, limits=FALSE, x.min=NULL, x.max=NULL, y
 
   names(dimnames(grid.density.obj))[2] <- title.text
   names(dimnames(grid.density.obj))[1] <- ''
-  
-  return(grid.density.obj)
-  
+
+  return(list(grid=grid.density.obj, class.x=class(xvect), class.y=class(yvect)))
+
 }
 # AGGREGATE FUNCTION
 # densityGridDS

R/heatmapPlotDS.R

@@ -9,20 +9,27 @@
 #' neighbours and the y-coordinate of the centroid is the average of the y-coordinates of the n nearest
 #' neighbours. The coordinates of the centroids return to the client side function and can be used for the
 #' plot of non-disclosive graphs (e.g. scatter plots, heatmap plots, contour plots, etc).    
-#' @param x the name of a numeric vector, the x-variable.
-#' @param y the name of a numeric vector, the y-variable.
+#' @param x.name a character string providing the name of a server-side numeric vector, the x-variable.
+#' @param y.name a character string providing the name of a server-side numeric vector, the y-variable.
 #' @param k the number of the nearest neighbours for which their centroid is calculated if the 
 #' \code{method.indicator} is equal to 1 (i.e. deterministic method).
 #' @param noise the percentage of the initial variance that is used as the variance of the embedded
 #' noise if the \code{method.indicator} is equal to 2 (i.e. probabilistic method).
 #' @param method.indicator a number equal to either 1 or 2. If the value is equal to 1 then the
 #' 'deterministic' method is used. If the value is set to 2 the 'probabilistic' method is used. 
 #' @return a list with the x and y coordinates of the centroids if the deterministic method is used
-#' or the x and y coordinated of the noisy data if the probabilistic method is used.
+#' or the x and y coordinated of the noisy data if the probabilistic method is used, along with the
+#' classes of the x and y inputs (\code{class.x} and \code{class.y})
 #' @author Demetris Avraam for DataSHIELD Development Team
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
-#' 
-heatmapPlotDS <- function(x, y, k, noise, method.indicator){
+#'
+heatmapPlotDS <- function(x.name, y.name, k, noise, method.indicator){
+
+  x <- .loadServersideObject(x.name)
+  y <- .loadServersideObject(y.name)
+  .checkClass(obj = x, obj_name = x.name, permitted_classes = c("numeric", "integer"))
+  .checkClass(obj = y, obj_name = y.name, permitted_classes = c("numeric", "integer"))
 
   ###################################################################
   # MODULE 1: CAPTURE THE nfilter SETTINGS                          #
@@ -125,8 +132,8 @@ heatmapPlotDS <- function(x, y, k, noise, method.indicator){
   }
 
   # Return a list with the x and y coordinates of the centroids
-  return(list(x.new, y.new))
-  
+  return(list(x.new, y.new, class.x=class(x), class.y=class(y)))
+
 }
 # AGGREGATE FUNCTION
 # heatmapPlotDS