Refactor/perf batch 9

R/ds.boxPlot.R

@@ -15,6 +15,7 @@
 #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
 #'
 #' @return \code{ggplot} object
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 #' @export
 #' @examples 
 #' \dontrun{
@@ -86,55 +87,22 @@
 ds.boxPlot <- function(x, variables = NULL, group = NULL, group2 = NULL, xlabel = "x axis", 
                        ylabel = "y axis", type = "pooled", datasources = NULL){
 
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
+  datasources <- .set_datasources(datasources)
 
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
-
   # Ensure type is 'pooled' or 'split'
   if((length(type) == 1) && (! any(type %in% c("pooled", "split")))){
     stop("[type] can only be set to 'pooled' or 'split'")
   }
-
-  # Check if x is defined and that it is of class "numeric" or "data.frame"
-  isDefined(datasources, x)
-  cls <- checkClass(datasources, x)
+
+  # Determine class of x for dispatch
+  cls <- datashield.aggregate(datasources, call("classDS", x))
+  .checkClassConsistency(lapply(cls, function(study.class) list(class = study.class)), object_name = x)
+  cls <- unique(unlist(cls))
+
   if(!any(c("numeric", "data.frame") %in% cls)){
     stop("The selected object is not a data frame nor a numerical vector")
   }
-
-  # If x is a "data.frame" check that the variables exist, and if they are "numeric"
-  # also check if the grouping variables [group, group2] exist and are of class factor
-  if("data.frame" %in% cls){
-    # Check that all variables exist
-    lapply(variables, function(i){
-      isDefined(datasources, paste0(x, "$", i))
-    })
-    # Check all variables are of class "numeric"
-    variable_classes <- unlist(lapply(variables, function(i){
-      checkClass(datasources, paste0(x, "$", i))
-    }))
-    if(!all(variable_classes == "numeric")){
-      stop("[", paste(variables[variable_classes != "numeric"], collapse = ", "), "] variable(s) are not of class 'numeric'")
-    }
-    # Check if grouping variables exist
-    if(!is.null(group)){isDefined(datasources, paste0(x, "$", group))}
-    if(!is.null(group2)){isDefined(datasources, paste0(x, "$", group2))}
-    # Check if groupings are of class "factor"
-    if(!is.null(group)){
-      group_class <- checkClass(datasources, paste0(x, "$", group))
-      if(group_class != "factor"){stop("[", group, "] is not of class 'factor'")}
-    }
-    if(!is.null(group2)){
-      group_class2 <- checkClass(datasources, paste0(x, "$", group2))
-      if(group_class2 != "factor"){stop("[", group2, "] is not of class 'factor'")}
-    }
-  }
-
+
   # Once all checks are passed, call the appropiate server functions
   if("data.frame" %in% cls){
     ds.boxPlotGG_table(x, variables, group, group2, xlabel, ylabel, type, datasources)

R/ds.boxPlotGG.R

@@ -20,51 +20,41 @@
 #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
 #'
 #' @return \code{ggplot} object
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 
 ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
   x_var <- lower <- upper <- ymin <- ymax <- middle <- fill <- NULL
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
-  cally <- paste0("boxPlotGGDS(", x, ", ", 
-                  if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ", 
-                  if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
-
-  pt <- DSI::datashield.aggregate(datasources, as.symbol(cally))
+  plot_data <- datashield.aggregate(datasources, call("boxPlotGGDS", data_table.name=x, group=group, group2=group2))
 
   if(type == "pooled"){
     num_servers <- length(names(datasources))
-    pt_merged <- NULL
+    plot_data_merged <- NULL
     for(i in 1:num_servers){
-      pt_merged <- rbind(pt_merged, pt[[i]]$data)
+      plot_data_merged <- rbind(plot_data_merged, plot_data[[i]]$data)
     }
-    pt_merged <- data.table::data.table(pt_merged)
+    plot_data_merged <- data.table::data.table(plot_data_merged)
     if(!is.null(group) & is.null(group2)){
-      pt_merged <- computeWeightedMeans(pt_merged, 
+      plot_data_merged <- computeWeightedMeans(plot_data_merged, 
                         variables = c("ymin", "lower", "middle", "upper", "ymax"), 
                         weight = "n", 
                         by = c("group", "x"))
     }
     else if(!is.null(group) & !is.null(group2)){
-      pt_merged <- computeWeightedMeans(pt_merged, 
+      plot_data_merged <- computeWeightedMeans(plot_data_merged, 
                         variables = c("ymin", "lower", "middle", "upper", "ymax"), 
                         weight = "n", 
                         by = c("group", "group2", "x"))
     }
     else{
-      pt_merged <- computeWeightedMeans(pt_merged, 
+      plot_data_merged <- computeWeightedMeans(plot_data_merged, 
                         variables = c("ymin", "lower", "middle", "upper", "ymax"), 
                         weight = "n", 
                         by = c("x"))
     }
-    if(pt[[1]][[length(pt[[1]])]] == "single_group"){
-      plt <- ggplot2::ggplot(pt_merged) +
+    if(plot_data[[1]][[length(plot_data[[1]])]] == "single_group"){
+      plt <- ggplot2::ggplot(plot_data_merged) +
         ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                               upper=upper, ymin=ymin,
                                                               ymax=ymax, middle=middle,
@@ -74,8 +64,8 @@
         ggplot2::ylab(ylabel) +
         ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
     }
-    else if(pt[[1]][[length(pt[[1]])]] == "double_group"){
-      plt <- ggplot2::ggplot(pt_merged) +
+    else if(plot_data[[1]][[length(plot_data[[1]])]] == "double_group"){
+      plt <- ggplot2::ggplot(plot_data_merged) +
         ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                               upper=upper, ymin=ymin,
                                                               ymax=ymax, middle=middle,
@@ -87,7 +77,7 @@
         ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
     }
     else{
-      plt <- ggplot2::ggplot(pt_merged) +
+      plt <- ggplot2::ggplot(plot_data_merged) +
         ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                               upper=upper, ymin=ymin,
                                                               ymax=ymax, middle=middle)) +
@@ -102,8 +92,8 @@
     num_servers <- length(names(datasources))
     plt <- NULL
     for(i in 1:num_servers){
-      if(pt[[i]][[length(pt[[i]])]] == "single_group"){
-        plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
+      if(plot_data[[i]][[length(plot_data[[i]])]] == "single_group"){
+        plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
           ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                                 upper=upper, ymin=ymin,
                                                                 ymax=ymax, middle=middle,
@@ -114,8 +104,8 @@
           ggplot2::ggtitle(paste0("Server: ", names(datasources[i]))) +
           ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
       }
-      else if(pt[[i]][[length(pt[[i]])]] == "double_group"){
-        plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
+      else if(plot_data[[i]][[length(plot_data[[i]])]] == "double_group"){
+        plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
           ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                                 upper=upper, ymin=ymin,
                                                                 ymax=ymax, middle=middle,
@@ -128,7 +118,7 @@
           ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
       }
       else{
-        plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
+        plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
           ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
                                                                 upper=upper, ymin=ymin,
                                                                 ymax=ymax, middle=middle)) +

R/ds.boxPlotGG_data_Treatment.R

@@ -16,23 +16,13 @@
 #'  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
 
 ds.boxPlotGG_data_Treatment <- function(table, variables, group = NULL, group2 = NULL, datasources = NULL){
 
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
+  datasources <- .set_datasources(datasources)
 
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
-
-  cally <- paste0("boxPlotGG_data_TreatmentDS(", table, ", c('", 
-                  paste0(variables, collapse = "','"), "'), ", 
-                  if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ", 
-                  if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
-  DSI::datashield.assign.expr(datasources, "boxPlotRawData", as.symbol(cally))
+  datashield.assign.expr(datasources, "boxPlotRawData", call("boxPlotGG_data_TreatmentDS", table.name = table, variables = variables, group = group, group2 = group2))
 
 
 }

R/ds.boxPlotGG_data_Treatment_numeric.R

@@ -11,19 +11,12 @@
 #'  Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr
 #'  Column 'value': Values for that variable \cr
 #'
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 
 ds.boxPlotGG_data_Treatment_numeric <- function(vector, datasources = NULL){
 
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
+  datasources <- .set_datasources(datasources)
 
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
-
-  cally <- paste0("boxPlotGG_data_Treatment_numericDS(", vector, ")")
-  DSI::datashield.assign.expr(datasources, "boxPlotRawDataNumeric", as.symbol(cally))
+  datashield.assign.expr(datasources, "boxPlotRawDataNumeric", call("boxPlotGG_data_Treatment_numericDS", vector.name = vector))
 
 }

R/ds.boxPlotGG_numeric.R

@@ -8,17 +8,11 @@
 #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
 #'
 #' @return \code{ggplot} object
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 
 ds.boxPlotGG_numeric <- function(x, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
 
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   ds.boxPlotGG_data_Treatment_numeric(x, datasources)
 

R/ds.boxPlotGG_table.R

@@ -13,18 +13,12 @@
 #' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
 #'
 #' @return \code{ggplot} object
+#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
 
 ds.boxPlotGG_table <- function(x, variables, group = NULL, group2 = NULL, xlabel = "x axis", 
                                ylabel = "y axis", type = "pooled", datasources = NULL){
 
-  if (is.null(datasources)) {
-    datasources <- DSI::datashield.connections_find()
-  }
-
-  # ensure datasources is a list of DSConnection-class
-  if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
-    stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
-  }
+  datasources <- .set_datasources(datasources)
 
   ds.boxPlotGG_data_Treatment(x, variables, group, group2, datasources)