Skip to content

Commit fdbb295

Browse files
Merge pull request #289 from ESCRI11/v6.1-dev
Added boxplot
2 parents feb7034 + 529f731 commit fdbb295

15 files changed

Lines changed: 554 additions & 2 deletions

DESCRIPTION

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,9 @@ Depends:
1010
DSI (>= 1.1.0)
1111
Imports:
1212
fields,
13-
metafor
13+
metafor,
14+
ggplot2,
15+
gridExtra,
16+
data.table
1417
RoxygenNote: 7.1.1
1518
Encoding: UTF-8

NAMESPACE

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,9 @@ export(ds.asLogical)
1111
export(ds.asMatrix)
1212
export(ds.asNumeric)
1313
export(ds.assign)
14+
export(ds.boxPlot)
15+
export(ds.boxPlotGG_numeric)
16+
export(ds.boxPlotGG_table)
1417
export(ds.c)
1518
export(ds.cbind)
1619
export(ds.changeRefGroup)

R/ds.boxPlot.R

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
#' @title Draw boxplot
2+
#'
3+
#' @description Draw boxplot with data on the study servers (data frames or numeric vectors) with the option
4+
#' of grouping using categorical variables on the dataset (only for data frames)
5+
#'
6+
#' @param x \code{character} Name of the data frame (or numeric vector) on the server side that
7+
#' holds the information to be plotted
8+
#' @param variables \code{character vector} Name of the column(s) of the data frame to include on the boxplot
9+
#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable.
10+
#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable.
11+
#' @param xlabel \code{caracter} (default \code{"x axis"}) Label to put on the x axis of the plot
12+
#' @param ylabel \code{caracter} (default \code{"y axis"}) Label to put on the y axis of the plot
13+
#' @param type \code{character} Return a pooled plot (\code{"pooled"}) or a split plot (one for each study server
14+
#' \code{"split"})
15+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
16+
#'
17+
#' @return \code{ggplot} object
18+
#' @export
19+
20+
ds.boxPlot <- function(x, variables = NULL, group = NULL, group2 = NULL, xlabel = "x axis",
21+
ylabel = "y axis", type = "pooled", datasources = NULL){
22+
23+
if (is.null(datasources)) {
24+
datasources <- DSI::datashield.connections_find()
25+
}
26+
27+
isDefined(datasources, x)
28+
cls <- checkClass(datasources, x)
29+
30+
if(any(cls %in% c("data.frame"))){
31+
ds.boxPlotGG_table(x, variables, group, group2, xlabel, ylabel, type, datasources)
32+
}
33+
else if(any(cls %in% c("numeric"))){
34+
ds.boxPlotGG_numeric(x, xlabel, ylabel, type, datasources)
35+
}
36+
else(stop("The selected object is not a data frame nor a numerical vector"))
37+
38+
}

R/ds.boxPlotGG.R

Lines changed: 176 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,176 @@
1+
#' @title Renders boxplot
2+
#'
3+
#' @description Internal function. Renders a ggplot boxplot by retrieving from the server side a list with the identity stats and other
4+
#' parameters to render the plot without passing any data from the original dataset
5+
#'
6+
#' @param x \code{character} Name on the server side of the data frame to form a boxplot. Structure on the server
7+
#' of this object must be: \cr
8+
#'
9+
#' Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr
10+
#' Column 'value': Values for that variable (raw data of columns rbinded) \cr
11+
#' Column 'group': (Optional) Values of the grouping variable \cr
12+
#' Column 'group2': (Optional) Values of the second grouping variable \cr
13+
#'
14+
#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable.
15+
#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable.
16+
#' @param xlabel \code{caracter} (default \code{"x axis"}) Label to put on the x axis of the plot
17+
#' @param ylabel \code{caracter} (default \code{"y axis"}) Label to put on the y axis of the plot
18+
#' @param type \code{character} Return a pooled plot (\code{"pooled"}) or a split plot (one for each study server
19+
#' \code{"split"})
20+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
21+
#'
22+
#' @return \code{ggplot} object
23+
24+
25+
26+
ds.boxPlotGG <- function(x, group = NULL, group2 = NULL, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
27+
x_var <- lower <- upper <- ymin <- ymax <- middle <- fill <- NULL
28+
if (is.null(datasources)) {
29+
datasources <- DSI::datashield.connections_find()
30+
}
31+
32+
cally <- paste0("boxPlotGGDS(", x, ", ",
33+
if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ",
34+
if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
35+
36+
pt <- DSI::datashield.aggregate(datasources, as.symbol(cally))
37+
# return(pt)
38+
if(type == "pooled"){
39+
num_servers <- length(names(datasources))
40+
pt <- lapply(pt, function(x) {x$data$ymin <- x$data$ymin * x$counts$n;
41+
x$data$lower <- x$data$lower * x$counts$n;
42+
x$data$middle <- x$data$middle * x$counts$n;
43+
x$data$upper <- x$data$upper * x$counts$n;
44+
x$data$ymax <- x$data$ymax * x$counts$n;
45+
x$data$PANEL <- as.numeric(x$data$PANEL) * x$counts$n;
46+
x$data$n <- x$counts$n;
47+
x$data$x_var <- rep(x[[2]], each = nrow(x$data)/length(x[[2]]));
48+
x$data$group <- x$data$group * x$counts$n;
49+
return(x)})
50+
51+
52+
# return(pt)
53+
54+
pt_merged <- NULL
55+
for(i in 1:num_servers){
56+
pt_merged <- rbind(pt_merged, pt[[i]]$data)
57+
}
58+
pt_merged <- data.table::data.table(pt_merged)
59+
if(!is.null(group)){
60+
pt_merged <- stats::aggregate(.~fill+x_var, pt_merged, sum)
61+
}
62+
else{pt_merged <- stats::aggregate(.~x_var, pt_merged, sum) }
63+
pt_merged$ymin <- pt_merged$ymin / pt_merged$n
64+
pt_merged$lower <- pt_merged$lower / pt_merged$n
65+
pt_merged$middle <- pt_merged$middle / pt_merged$n
66+
pt_merged$upper <- pt_merged$upper / pt_merged$n
67+
pt_merged$ymax <- pt_merged$ymax / pt_merged$n
68+
pt_merged$PANEL <- as.numeric(pt_merged$PANEL) / pt_merged$n
69+
70+
# return(pt_merged)
71+
72+
if(pt[[1]][[length(pt[[1]])]] == "single_group"){
73+
plt <- ggplot2::ggplot(pt_merged) +
74+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
75+
upper=upper, ymin=ymin,
76+
ymax=ymax, middle=middle,
77+
fill = fill)) +
78+
ggplot2::scale_fill_brewer(name = "Group") +
79+
ggplot2::xlab(xlabel) +
80+
ggplot2::ylab(ylabel) +
81+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
82+
}
83+
else if(pt[[1]][[length(pt[[1]])]] == "double_group"){
84+
85+
supp.labs <- as.character(levels(pt[[1]][[4]]))
86+
names(supp.labs) <- seq(from = 1, length.out = length(pt[[1]][[4]]))
87+
88+
plt <- ggplot2::ggplot(pt_merged) +
89+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
90+
upper=upper, ymin=ymin,
91+
ymax=ymax, middle=middle,
92+
fill = fill, group = group)) +
93+
ggplot2::facet_wrap(~ PANEL, labeller = ggplot2::labeller(PANEL = supp.labs)) +
94+
# ggplot2::scale_x_discrete(limits = levels(pt[[1]][[2]])) +
95+
ggplot2::scale_fill_brewer(name = "Group") +
96+
ggplot2::xlab(xlabel) +
97+
ggplot2::ylab(ylabel) +
98+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
99+
}
100+
else{
101+
# return(pt_merged)
102+
plt <- ggplot2::ggplot(pt_merged) +
103+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
104+
upper=upper, ymin=ymin,
105+
ymax=ymax, middle=middle)) +
106+
# ggplot2::scale_x_discrete(limits = levels(pt[[1]][[2]])) +
107+
ggplot2::scale_fill_brewer(name = "Group") +
108+
ggplot2::xlab(xlabel) +
109+
ggplot2::ylab(ylabel) +
110+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
111+
}
112+
113+
}
114+
else if(type == "split"){
115+
pt <- lapply(pt, function(x) {
116+
x$data$n <- x$counts$n;
117+
x$data$x_var <- rep(x[[2]], each = nrow(x$data)/length(x[[2]]));
118+
return(x)})
119+
120+
num_servers <- length(names(datasources))
121+
plt <- NULL
122+
for(i in 1:num_servers){
123+
if(pt[[i]][[length(pt[[i]])]] == "single_group"){
124+
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
125+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
126+
upper=upper, ymin=ymin,
127+
ymax=ymax, middle=middle,
128+
fill = fill)) +
129+
# ggplot2::scale_x_discrete(limits = levels(pt[[i]][[2]])) +
130+
ggplot2::scale_fill_brewer(name = "Group") +
131+
ggplot2::xlab(xlabel) +
132+
ggplot2::ylab(ylabel) +
133+
ggplot2::ggtitle(paste0("Server: ", names(datasources[i]))) +
134+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
135+
}
136+
else if(pt[[i]][[length(pt[[i]])]] == "double_group"){
137+
138+
supp.labs <- as.character(levels(pt[[i]][[4]]))
139+
names(supp.labs) <- seq(from = 1, length.out = length(pt[[i]][[4]]))
140+
141+
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
142+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
143+
upper=upper, ymin=ymin,
144+
ymax=ymax, middle=middle,
145+
fill = fill)) +
146+
ggplot2::facet_wrap(~ PANEL, labeller = ggplot2::labeller(PANEL = supp.labs)) +
147+
# ggplot2::scale_x_discrete(limits = levels(pt[[i]][[2]])) +
148+
ggplot2::scale_fill_brewer(name = "Group") +
149+
ggplot2::xlab(xlabel) +
150+
ggplot2::ylab(ylabel) +
151+
ggplot2::ggtitle(paste0("Server: ", names(datasources[i]))) +
152+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
153+
}
154+
else{
155+
plt[[i]] <- ggplot2::ggplot(pt[[i]][[1]]) +
156+
ggplot2::geom_boxplot(stat = "identity", ggplot2::aes(x=x_var, lower=lower,
157+
upper=upper, ymin=ymin,
158+
ymax=ymax, middle=middle)) +
159+
# ggplot2::scale_x_discrete(limits = levels(pt[[i]][[2]])) +
160+
# ggplot2::scale_fill_brewer(name = "Group", labels = (pt[[i]][[3]])) +
161+
ggplot2::xlab(xlabel) +
162+
ggplot2::ylab(ylabel) +
163+
ggplot2::ggtitle(paste0("Server: ", names(datasources[i]))) +
164+
ggplot2::theme(axis.text.x = ggplot2::element_text(angle = 90, hjust = 1))
165+
}
166+
}
167+
168+
plt <- do.call(gridExtra::grid.arrange, plt)
169+
170+
}
171+
else{stop("Invalid type")}
172+
173+
174+
return(plt)
175+
176+
}

R/ds.boxPlotGG_data_Treatment.R

Lines changed: 33 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,33 @@
1+
#' @title Take a data frame on the server side an arrange it to pass it to the boxplot function
2+
#'
3+
#' @description Internal function
4+
#'
5+
#' @param table \code{character} Name of the table on the server side that holds the information to be plotted later
6+
#' @param variables \code{character vector} Name of the column(s) of the data frame to include on the boxplot
7+
#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable.
8+
#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable.
9+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
10+
#'
11+
#' @return Does not return nothing, it creates the table \code{"boxPlotRawData"} on the server arranged to be passed to the
12+
#' ggplot boxplot function. Structure of the created table: \cr
13+
#'
14+
#' Column 'x': Names on the X axis of the boxplot, aka variables to plot \cr
15+
#' Column 'value': Values for that variable (raw data of columns rbinded) \cr
16+
#' Column 'group': (Optional) Values of the grouping variable \cr
17+
#' Column 'group2': (Optional) Values of the second grouping variable \cr
18+
#'
19+
20+
ds.boxPlotGG_data_Treatment <- function(table, variables, group = NULL, group2 = NULL, datasources = NULL){
21+
22+
if (is.null(datasources)) {
23+
datasources <- DSI::datashield.connections_find()
24+
}
25+
26+
cally <- paste0("boxPlotGG_data_TreatmentDS(", table, ", c('",
27+
paste0(variables, collapse = "','"), "'), ",
28+
if(is.null(group)){paste0("NULL")}else{paste0("'",group,"'")}, ", ",
29+
if(is.null(group2)){paste0("NULL")}else{paste0("'",group2,"'")}, ")")
30+
DSI::datashield.assign.expr(datasources, "boxPlotRawData", as.symbol(cally))
31+
32+
33+
}
Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
#' @title Take a vector on the server side an arrange it to pass it to the boxplot function
2+
#'
3+
#' @description Internal function
4+
#'
5+
#' @param vector \code{character} Name of the table on the server side that holds the information to be plotted later
6+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
7+
#'
8+
#' @return Does not return nothing, it creates the table \code{"boxPlotRawDataNumeric"} on the server arranged to be passed to the
9+
#' ggplot boxplot function. Structure of the created table: \cr
10+
#'
11+
#' Column 'x': Names on the X axis of the boxplot, aka name of the vector (vector argument) \cr
12+
#' Column 'value': Values for that variable \cr
13+
#'
14+
15+
ds.boxPlotGG_data_Treatment_numeric <- function(vector, datasources = NULL){
16+
17+
if (is.null(datasources)) {
18+
datasources <- DSI::datashield.connections_find()
19+
}
20+
21+
cally <- paste0("boxPlotGG_data_Treatment_numericDS(", vector, ")")
22+
DSI::datashield.assign.expr(datasources, "boxPlotRawDataNumeric", as.symbol(cally))
23+
24+
}

R/ds.boxPlotGG_numeric.R

Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
#' @title Draw boxplot with information from a numeric vector
2+
#'
3+
#'
4+
#' @param x \code{character} Name of the numeric vector on the server side that holds the information to be plotted
5+
#' @param xlabel \code{caracter} (default \code{"x axis"}) Label to put on the x axis of the plot
6+
#' @param ylabel \code{caracter} (default \code{"y axis"}) Label to put on the y axis of the plot
7+
#' @param type \code{character} Return a pooled plot (\code{"pooled"}) or a split plot (one for each study server
8+
#' \code{"split"})
9+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
10+
#'
11+
#' @return \code{ggplot} object
12+
#' @export
13+
14+
ds.boxPlotGG_numeric <- function(x, xlabel = "x axis", ylabel = "y axis", type = "pooled", datasources = NULL){
15+
16+
if (is.null(datasources)) {
17+
datasources <- DSI::datashield.connections_find()
18+
}
19+
20+
ds.boxPlotGG_data_Treatment_numeric(x, datasources)
21+
22+
ds.boxPlotGG("boxPlotRawDataNumeric", NULL, NULL, xlabel, ylabel, type, datasources)
23+
24+
}

R/ds.boxPlotGG_table.R

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
#' @title Draw boxplot with information from a data frame
2+
#'
3+
#' @description Draws a boxplot with the option of adding two grouping variables from data held on a table
4+
#'
5+
#' @param x \code{character} Name of the table on the server side that holds the information to be plotted
6+
#' @param variables \code{character vector} Name of the column(s) of the data frame to include on the boxplot
7+
#' @param group \code{character} (default \code{NULL}) Name of the first grouping variable.
8+
#' @param group2 \code{character} (default \code{NULL}) Name of the second grouping variable.
9+
#' @param xlabel \code{caracter} (default \code{"x axis"}) Label to put on the x axis of the plot
10+
#' @param ylabel \code{caracter} (default \code{"y axis"}) Label to put on the y axis of the plot
11+
#' @param type \code{character} Return a pooled plot (\code{"pooled"}) or a split plot (one for each study server
12+
#' \code{"split"})
13+
#' @param datasources a list of \code{\link{DSConnection-class}} (default \code{NULL}) objects obtained after login
14+
#'
15+
#' @return \code{ggplot} object
16+
#' @export
17+
18+
ds.boxPlotGG_table <- function(x, variables, group = NULL, group2 = NULL, xlabel = "x axis",
19+
ylabel = "y axis", type = "pooled", datasources = NULL){
20+
21+
if (is.null(datasources)) {
22+
datasources <- DSI::datashield.connections_find()
23+
}
24+
25+
ds.boxPlotGG_data_Treatment(x, variables, group, group2, datasources)
26+
27+
ds.boxPlotGG("boxPlotRawData", group, group2, xlabel, ylabel, type, datasources)
28+
29+
}

azure-pipelines.yml

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -130,7 +130,8 @@ jobs:
130130
sudo apt-get update
131131
132132
sudo apt-get install -qq libxml2-dev libcurl4-openssl-dev libssl-dev libgsl-dev r-base -y
133-
sudo R -q -e "install.packages(c('devtools','metafor','fields','covr'), dependencies=TRUE, repos='https://cloud.r-project.org')"
133+
sudo R -q -e "install.packages(c('devtools','covr'), dependencies=TRUE, repos='https://cloud.r-project.org')"
134+
sudo R -q -e "install.packages(c('fields','metafor','ggplot2','gridExtra','data.table'), dependencies=TRUE, repos='https://cloud.r-project.org')"
134135
sudo R -q -e "install.packages(c('DSI','DSOpal','DSLite'), dependencies=TRUE, repos='https://cloud.r-project.org')"
135136
136137
sudo R -q -e "install.packages(c('DescTools','e1071'), dependencies=TRUE, repos='https://cloud.r-project.org')"

0 commit comments

Comments
 (0)