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+ }
0 commit comments