Skip to content

Commit 2384659

Browse files
timcadmantimcadman
authored
Merge pull request #704 from datashield/refactor/perf-batch-9
Refactor/perf batch 9
2 parents 943fe26 + ef44a43 commit 2384659

39 files changed

Lines changed: 953 additions & 287 deletions

‎R/ds.boxPlot.R‎

Lines changed: 9 additions & 41 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@
1515
#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
1616
#'
1717
#' @return \code{ggplot} object
18+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
1819
#' @export
1920
#' @examples
2021
#' \dontrun{
@@ -86,55 +87,22 @@
8687
ds.boxPlot <- function(x, variables = NULL, group = NULL, group2 = NULL, xlabel = "x axis",
8788
ylabel = "y axis", type = "pooled", datasources = NULL){
8889

89-
if (is.null(datasources)) {
90-
datasources <- DSI::datashield.connections_find()
91-
}
90+
datasources <- .set_datasources(datasources)
9291

93-
# ensure datasources is a list of DSConnection-class
94-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
95-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
96-
}
97-
9892
# Ensure type is 'pooled' or 'split'
9993
if((length(type) == 1) && (! any(type %in% c("pooled", "split")))){
10094
stop("[type] can only be set to 'pooled' or 'split'")
10195
}
102-
103-
# Check if x is defined and that it is of class "numeric" or "data.frame"
104-
isDefined(datasources, x)
105-
cls <- checkClass(datasources, x)
96+
97+
# Determine class of x for dispatch
98+
cls <- datashield.aggregate(datasources, call("classDS", x))
99+
.checkClassConsistency(lapply(cls, function(study.class) list(class = study.class)), object_name = x)
100+
cls <- unique(unlist(cls))
101+
106102
if(!any(c("numeric", "data.frame") %in% cls)){
107103
stop("The selected object is not a data frame nor a numerical vector")
108104
}
109-
110-
# If x is a "data.frame" check that the variables exist, and if they are "numeric"
111-
# also check if the grouping variables [group, group2] exist and are of class factor
112-
if("data.frame" %in% cls){
113-
# Check that all variables exist
114-
lapply(variables, function(i){
115-
isDefined(datasources, paste0(x, "$", i))
116-
})
117-
# Check all variables are of class "numeric"
118-
variable_classes <- unlist(lapply(variables, function(i){
119-
checkClass(datasources, paste0(x, "$", i))
120-
}))
121-
if(!all(variable_classes == "numeric")){
122-
stop("[", paste(variables[variable_classes != "numeric"], collapse = ", "), "] variable(s) are not of class 'numeric'")
123-
}
124-
# Check if grouping variables exist
125-
if(!is.null(group)){isDefined(datasources, paste0(x, "$", group))}
126-
if(!is.null(group2)){isDefined(datasources, paste0(x, "$", group2))}
127-
# Check if groupings are of class "factor"
128-
if(!is.null(group)){
129-
group_class <- checkClass(datasources, paste0(x, "$", group))
130-
if(group_class != "factor"){stop("[", group, "] is not of class 'factor'")}
131-
}
132-
if(!is.null(group2)){
133-
group_class2 <- checkClass(datasources, paste0(x, "$", group2))
134-
if(group_class2 != "factor"){stop("[", group2, "] is not of class 'factor'")}
135-
}
136-
}
137-
105+
138106
# Once all checks are passed, call the appropiate server functions
139107
if("data.frame" %in% cls){
140108
ds.boxPlotGG_table(x, variables, group, group2, xlabel, ylabel, type, datasources)

‎R/ds.boxPlotGG.R‎

Lines changed: 19 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -20,51 +20,41 @@
2020
#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
2121
#'
2222
#' @return \code{ggplot} object
23+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
2324

2425
ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
2526
x_var <- lower <- upper <- ymin <- ymax <- middle <- fill <- NULL
26-
if (is.null(datasources)) {
27-
datasources <- DSI::datashield.connections_find()
28-
}
29-
30-
# ensure datasources is a list of DSConnection-class
31-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
32-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
33-
}
27+
datasources <- .set_datasources(datasources)
3428

35-
cally <- paste0("boxPlotGGDS(", x, ", ",
36-
if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ",
37-
if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
38-
39-
pt <- DSI::datashield.aggregate(datasources, as.symbol(cally))
29+
plot_data <- datashield.aggregate(datasources, call("boxPlotGGDS", data_table.name=x, group=group, group2=group2))
4030

4131
if(type == "pooled"){
4232
num_servers <- length(names(datasources))
43-
pt_merged <- NULL
33+
plot_data_merged <- NULL
4434
for(i in 1:num_servers){
45-
pt_merged <- rbind(pt_merged, pt[[i]]$data)
35+
plot_data_merged <- rbind(plot_data_merged, plot_data[[i]]$data)
4636
}
47-
pt_merged <- data.table::data.table(pt_merged)
37+
plot_data_merged <- data.table::data.table(plot_data_merged)
4838
if(!is.null(group) & is.null(group2)){
49-
pt_merged <- computeWeightedMeans(pt_merged,
39+
plot_data_merged <- computeWeightedMeans(plot_data_merged,
5040
variables = c("ymin", "lower", "middle", "upper", "ymax"),
5141
weight = "n",
5242
by = c("group", "x"))
5343
}
5444
else if(!is.null(group) & !is.null(group2)){
55-
pt_merged <- computeWeightedMeans(pt_merged,
45+
plot_data_merged <- computeWeightedMeans(plot_data_merged,
5646
variables = c("ymin", "lower", "middle", "upper", "ymax"),
5747
weight = "n",
5848
by = c("group", "group2", "x"))
5949
}
6050
else{
61-
pt_merged <- computeWeightedMeans(pt_merged,
51+
plot_data_merged <- computeWeightedMeans(plot_data_merged,
6252
variables = c("ymin", "lower", "middle", "upper", "ymax"),
6353
weight = "n",
6454
by = c("x"))
6555
}
66-
if(pt[[1]][[length(pt[[1]])]] == "single_group"){
67-
plt <- ggplot2::ggplot(pt_merged) +
56+
if(plot_data[[1]][[length(plot_data[[1]])]] == "single_group"){
57+
plt <- ggplot2::ggplot(plot_data_merged) +
6858
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
6959
upper=upper, ymin=ymin,
7060
ymax=ymax, middle=middle,
@@ -74,8 +64,8 @@ ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylab
7464
ggplot2::ylab(ylabel) +
7565
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
7666
}
77-
else if(pt[[1]][[length(pt[[1]])]] == "double_group"){
78-
plt <- ggplot2::ggplot(pt_merged) +
67+
else if(plot_data[[1]][[length(plot_data[[1]])]] == "double_group"){
68+
plt <- ggplot2::ggplot(plot_data_merged) +
7969
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
8070
upper=upper, ymin=ymin,
8171
ymax=ymax, middle=middle,
@@ -87,7 +77,7 @@ ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylab
8777
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
8878
}
8979
else{
90-
plt <- ggplot2::ggplot(pt_merged) +
80+
plt <- ggplot2::ggplot(plot_data_merged) +
9181
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
9282
upper=upper, ymin=ymin,
9383
ymax=ymax, middle=middle)) +
@@ -102,8 +92,8 @@ ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylab
10292
num_servers <- length(names(datasources))
10393
plt <- NULL
10494
for(i in 1:num_servers){
105-
if(pt[[i]][[length(pt[[i]])]] == "single_group"){
106-
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
95+
if(plot_data[[i]][[length(plot_data[[i]])]] == "single_group"){
96+
plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
10797
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
10898
upper=upper, ymin=ymin,
10999
ymax=ymax, middle=middle,
@@ -114,8 +104,8 @@ ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylab
114104
ggplot2::ggtitle(paste0("Server: ", names(datasources[i]))) +
115105
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
116106
}
117-
else if(pt[[i]][[length(pt[[i]])]] == "double_group"){
118-
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
107+
else if(plot_data[[i]][[length(plot_data[[i]])]] == "double_group"){
108+
plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
119109
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
120110
upper=upper, ymin=ymin,
121111
ymax=ymax, middle=middle,
@@ -128,7 +118,7 @@ ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylab
128118
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
129119
}
130120
else{
131-
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
121+
plt[[i]] <- ggplot2::ggplot(plot_data[[i]][[1]]) +
132122
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x, lower=lower,
133123
upper=upper, ymin=ymin,
134124
ymax=ymax, middle=middle)) +

‎R/ds.boxPlotGG_data_Treatment.R‎

Lines changed: 3 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -16,23 +16,13 @@
1616
#' Column 'group': (Optional) Values of the grouping variable \cr
1717
#' Column 'group2': (Optional) Values of the second grouping variable \cr
1818
#'
19+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
1920

2021
ds.boxPlotGG_data_Treatment <- function(table, variables, group = NULL, group2 = NULL, datasources = NULL){
2122

22-
if (is.null(datasources)) {
23-
datasources <- DSI::datashield.connections_find()
24-
}
23+
datasources <- .set_datasources(datasources)
2524

26-
# ensure datasources is a list of DSConnection-class
27-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
28-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
29-
}
30-
31-
cally <- paste0("boxPlotGG_data_TreatmentDS(", table, ", c('",
32-
paste0(variables, collapse = "','"), "'), ",
33-
if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ",
34-
if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
35-
DSI::datashield.assign.expr(datasources, "boxPlotRawData", as.symbol(cally))
25+
datashield.assign.expr(datasources, "boxPlotRawData", call("boxPlotGG_data_TreatmentDS", table.name = table, variables = variables, group = group, group2 = group2))
3626

3727

3828
}

‎R/ds.boxPlotGG_data_Treatment_numeric.R‎

Lines changed: 3 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -11,19 +11,12 @@
1111
#' Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr
1212
#' Column 'value': Values for that variable \cr
1313
#'
14+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
1415

1516
ds.boxPlotGG_data_Treatment_numeric <- function(vector, datasources = NULL){
1617

17-
if (is.null(datasources)) {
18-
datasources <- DSI::datashield.connections_find()
19-
}
18+
datasources <- .set_datasources(datasources)
2019

21-
# ensure datasources is a list of DSConnection-class
22-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
23-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
24-
}
25-
26-
cally <- paste0("boxPlotGG_data_Treatment_numericDS(", vector, ")")
27-
DSI::datashield.assign.expr(datasources, "boxPlotRawDataNumeric", as.symbol(cally))
20+
datashield.assign.expr(datasources, "boxPlotRawDataNumeric", call("boxPlotGG_data_Treatment_numericDS", vector.name = vector))
2821

2922
}

‎R/ds.boxPlotGG_numeric.R‎

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,11 @@
88
#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
99
#'
1010
#' @return \code{ggplot} object
11+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
1112

1213
ds.boxPlotGG_numeric <- function(x, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
1314

14-
if (is.null(datasources)) {
15-
datasources <- DSI::datashield.connections_find()
16-
}
17-
18-
# ensure datasources is a list of DSConnection-class
19-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
20-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
21-
}
15+
datasources <- .set_datasources(datasources)
2216

2317
ds.boxPlotGG_data_Treatment_numeric(x, datasources)
2418

‎R/ds.boxPlotGG_table.R‎

Lines changed: 2 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -13,18 +13,12 @@
1313
#' @param datasources a list of \code{\link[DSI]{DSConnection-class}} (default \code{NULL}) objects obtained after login
1414
#'
1515
#' @return \code{ggplot} object
16+
#' @author Tim Cadman, Genomics Coordination Centre, UMCG, Netherlands
1617

1718
ds.boxPlotGG_table <- function(x, variables, group = NULL, group2 = NULL, xlabel = "x axis",
1819
ylabel = "y axis", type = "pooled", datasources = NULL){
1920

20-
if (is.null(datasources)) {
21-
datasources <- DSI::datashield.connections_find()
22-
}
23-
24-
# ensure datasources is a list of DSConnection-class
25-
if(!(is.list(datasources) && all(unlist(lapply(datasources, function(d) {methods::is(d,"DSConnection")}))))){
26-
stop("The 'datasources' were expected to be a list of DSConnection-class objects", call.=FALSE)
27-
}
21+
datasources <- .set_datasources(datasources)
2822

2923
ds.boxPlotGG_data_Treatment(x, variables, group, group2, datasources)
3024

0 commit comments

Comments
 (0)