Skip to content

Commit f99c8ec

Browse files
Merge pull request #250 from davraam/v6.1-dev
add return.coords argument to allow the display of anonymised coordin…
2 parents 84be8a6 + 01e64e1 commit f99c8ec

7 files changed

Lines changed: 441 additions & 9 deletions

File tree

NAMESPACE

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
# Generated by roxygen2: do not edit by hand
22

33
export(ds.Boole)
4+
export(ds.abs)
45
export(ds.asCharacter)
56
export(ds.asDataMatrix)
67
export(ds.asFactor)
@@ -85,6 +86,7 @@ export(ds.seq)
8586
export(ds.setDefaultOpals)
8687
export(ds.setSeed)
8788
export(ds.skewness)
89+
export(ds.sqrt)
8890
export(ds.subset)
8991
export(ds.subsetByClass)
9092
export(ds.summary)

R/ds.abs.R

Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
#'
2+
#' @title Computes the absolute values of a variable
3+
#' @description Computes the absolute values for a specified numeric or integer vector.
4+
#' This function is similar to R function \code{abs}.
5+
#' @details The function calls the server-side function \code{absDS} that computes the
6+
#' absolute values of the elements of a numeric or integer vector and assigns a new vector
7+
#' with those absolute values on the server-side. The name of the new generated vector is
8+
#' specified by the user through the argument \code{newobj}, otherwise is named by default to
9+
#' \code{abs.newobj}.
10+
#' @param x a character string providing the name of a numeric or an integer vector.
11+
#' @param newobj a character string that provides the name for the output variable
12+
#' that is stored on the data servers. Default name is set to \code{abs.newobj}.
13+
#' @param datasources a list of \code{\link{DSConnection-class}} objects obtained after login.
14+
#' If the \code{datasources} argument is not specified the default set of connections will be
15+
#' used: see \code{\link{datashield.connections_default}}.
16+
#' @return \code{ds.abs} assigns a vector for each study that includes the absolute values of
17+
#' the input numeric or integer vector specified in the argument \code{x}. The created vectors
18+
#' are stored in the servers.
19+
#' @author Demetris Avraam for DataSHIELD Development Team
20+
#' @export
21+
#' @examples
22+
#' \dontrun{
23+
#'
24+
#' # Connecting to the Opal servers
25+
#'
26+
#' require('DSI')
27+
#' require('DSOpal')
28+
#' require('dsBaseClient')
29+
#'
30+
#' builder <- DSI::newDSLoginBuilder()
31+
#' builder$append(server = "study1",
32+
#' url = "http://192.168.56.100:8080/",
33+
#' user = "administrator", password = "datashield_test&",
34+
#' table = "CNSIM.CNSIM1", driver = "OpalDriver")
35+
#' builder$append(server = "study2",
36+
#' url = "http://192.168.56.100:8080/",
37+
#' user = "administrator", password = "datashield_test&",
38+
#' table = "CNSIM.CNSIM2", driver = "OpalDriver")
39+
#' builder$append(server = "study3",
40+
#' url = "http://192.168.56.100:8080/",
41+
#' user = "administrator", password = "datashield_test&",
42+
#' table = "CNSIM.CNSIM3", driver = "OpalDriver")
43+
#'
44+
#' logindata <- builder$build()
45+
#'
46+
#' # Log onto the remote Opal training servers
47+
#' connections <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D")
48+
#'
49+
#' # Example 1: Generate a normally distributed variable with zero mean and variance equal
50+
#' # to one and then get their absolute values
51+
#' ds.rNorm(samp.size=100, mean=0, sd=1, newobj='var.norm', datasources=connections)
52+
#' # check the quantiles
53+
#' ds.summary(x='var.norm', datasources=connections)
54+
#' ds.abs(x='var.norm', newobj='var.norm.abs', datasources=connections)
55+
#' # check now the changes in the quantiles
56+
#' ds.summary(x='var.norm.abs', datasources=connections)
57+
#'
58+
#' # Example 2: Generate a sequence of negative integer numbers from -200 to -100
59+
#' # and then get their absolute values
60+
#' ds.seq(FROM.value.char = '-200', TO.value.char = '-100', BY.value.char = '1',
61+
#' newobj='negative.integers', datasources=connections)
62+
#' # check the quantiles
63+
#' ds.summary(x='negative.integers', datasources=connections)
64+
#' ds.abs(x='negative.integers', newobj='positive.integers', datasources=connections)
65+
#' # check now the changes in the quantiles
66+
#' ds.summary(x='positive.integers', datasources=connections)
67+
#'
68+
#' # clear the Datashield R sessions and logout
69+
#' datashield.logout(connections)
70+
#'
71+
#' }
72+
#'
73+
ds.abs <- function(x=NULL, newobj=NULL, datasources=NULL){
74+
75+
# look for DS connections
76+
if(is.null(datasources)){
77+
datasources <- datashield.connections_find()
78+
}
79+
80+
if(is.null(x)){
81+
stop("Please provide the name of the input object!", call.=FALSE)
82+
}
83+
84+
# the input variable might be given as column table (i.e. D$x)
85+
# or just as a vector not attached to a table (i.e. x)
86+
# we have to make sure the function deals with each case
87+
xnames <- extract(x)
88+
varname <- xnames$elements
89+
obj2lookfor <- xnames$holders
90+
91+
# check if the input object(s) is(are) defined in all the studies
92+
if(is.na(obj2lookfor)){
93+
defined <- isDefined(datasources, varname)
94+
}else{
95+
defined <- isDefined(datasources, obj2lookfor)
96+
}
97+
98+
# call the internal function that checks the input object is of the same class in all studies.
99+
typ <- checkClass(datasources, x)
100+
101+
# call the internal function that checks the input object(s) is(are) of the same class in all studies.
102+
if(!('numeric' %in% typ) && !('integer' %in% typ)){
103+
stop("Only objects of type 'numeric' or 'integer' are allowed.", call.=FALSE)
104+
}
105+
106+
# create a name by default if the user did not provide a name for the new variable
107+
if(is.null(newobj)){
108+
newobj <- "abs.newobj"
109+
}
110+
111+
# call the server side function that does the operation
112+
cally <- call("absDS", x)
113+
DSI::datashield.assign(datasources, newobj, cally)
114+
115+
# check that the new object has been created and display a message accordingly
116+
finalcheck <- isAssigned(datasources, newobj)
117+
118+
}

R/ds.scatterPlot.R

Lines changed: 23 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,8 @@
6262
#' This can be set as \code{'combine'} or \code{'split'}.
6363
#' Default \code{'split'}.
6464
#' For more information see \strong{Details}.
65+
#' @param return.coords a logical. If TRUE the coordinates of the anonymised data points are return
66+
#' to the Console. Default value is FALSE.
6567
#' @param datasources a list of \code{\link{DSConnection-class}} objects obtained after login.
6668
#' If the \code{datasources} argument is not specified
6769
#' the default set of connections will be used: see \code{\link{datashield.connections_default}}.
@@ -110,7 +112,8 @@
110112
#' datasources = connections)
111113
#'
112114
#' #Example 2: generate a combined scatter plot with the probabilistic method
113-
#' #and noise = 0.5
115+
#' #and noise of variance 0.5% of the variable's variance, and display the coordinates
116+
#' # of the anonymised data points to the Console
114117
#'
115118
#' ds.scatterPlot(x = "D$PM_BMI_CONTINUOUS",
116119
#' y = "D$LAB_GLUC_ADJUSTED",
@@ -124,17 +127,17 @@
124127
#'
125128
#' }
126129
#'
127-
ds.scatterPlot <- function (x=NULL, y=NULL, method='deterministic', k=3, noise=0.25, type="split", datasources=NULL){
130+
ds.scatterPlot <- function (x=NULL, y=NULL, method='deterministic', k=3, noise=0.25, type="split", return.coords=FALSE, datasources=NULL){
128131

129-
# look for DS connections
130132
if(is.null(x)){
131-
stop("Please provide the x-variable", call.=FALSE)
133+
stop("Please provide the name of the x-variable", call.=FALSE)
132134
}
133135

134136
if(is.null(y)){
135-
stop("Please provide the y-variable", call.=FALSE)
137+
stop("Please provide the name of the y-variable", call.=FALSE)
136138
}
137139

140+
# look for DS connections
138141
if(is.null(datasources)){
139142
datasources <- datashield.connections_find()
140143
}
@@ -199,6 +202,7 @@ ds.scatterPlot <- function (x=NULL, y=NULL, method='deterministic', k=3, noise=0
199202
}
200203
pooled.points.x <- unlist(pooled.points.x)
201204
pooled.points.y <- unlist(pooled.points.y)
205+
pooled.coordinates <- cbind(x=pooled.points.x, y=pooled.points.y)
202206

203207
# plot and return the scatter plot depending on the argument "type"
204208
if(type=="combine"){
@@ -207,7 +211,11 @@ ds.scatterPlot <- function (x=NULL, y=NULL, method='deterministic', k=3, noise=0
207211
graphics::par(mfrow=c(numr,numc))
208212
graphics::plot(pooled.points.x, pooled.points.y, xlab=x.lab, ylab=y.lab, main=paste0("Combined scatter plot"))
209213
return.message <- "Combined plot created"
210-
return(return.message)
214+
if(isTRUE(return.coords)){
215+
return(list(pooled.coordinates=pooled.coordinates, message=return.message))
216+
}else{
217+
return(message=return.message)
218+
}
211219
}else{
212220
if(type=="split"){
213221
# set the graph area and plot
@@ -216,15 +224,22 @@ ds.scatterPlot <- function (x=NULL, y=NULL, method='deterministic', k=3, noise=0
216224
numc <- 2
217225
graphics::par(mfrow=c(numr,numc))
218226
scatter <- list()
219-
}
227+
}
228+
split.coordinates <- list()
220229
for(i in 1:num.sources){
221230
title <- paste0("Scatter plot of ", stdnames[i])
222231
x <- output[[i]][[1]]
223232
y <- output[[i]][[2]]
224233
graphics::plot(x, y, xlab=x.lab, ylab=y.lab, main=title)
234+
split.coordinates[[i]] <- cbind(x=output[[i]][[1]], y=output[[i]][[2]])
225235
}
236+
names(split.coordinates) <- stdnames
226237
return.message <- "Split plot created"
227-
return(return.message)
238+
if(isTRUE(return.coords)){
239+
return(list(split.coordinates, message=return.message))
240+
}else{
241+
return(message=return.message)
242+
}
228243
}else{
229244
stop('Function argument "type" has to be either "combine" or "split"')
230245
}

R/ds.sqrt.R

Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
#'
2+
#' @title Computes the square root values of a variable
3+
#' @description Computes the square root values for a specified numeric or integer vector.
4+
#' This function is similar to R function \code{sqrt}.
5+
#' @details The function calls the server-side function \code{sqrtDS} that computes the
6+
#' square root values of the elements of a numeric or integer vector and assigns a new vector
7+
#' with those square root values on the server-side. The name of the new generated vector is
8+
#' specified by the user through the argument \code{newobj}, otherwise is named by default to
9+
#' \code{sqrt.newobj}.
10+
#' @param x a character string providing the name of a numeric or an integer vector.
11+
#' @param newobj a character string that provides the name for the output variable
12+
#' that is stored on the data servers. Default name is set to \code{sqrt.newobj}.
13+
#' @param datasources a list of \code{\link{DSConnection-class}} objects obtained after login.
14+
#' If the \code{datasources} argument is not specified the default set of connections will be
15+
#' used: see \code{\link{datashield.connections_default}}.
16+
#' @return \code{ds.sqrt} assigns a vector for each study that includes the square root values of
17+
#' the input numeric or integer vector specified in the argument \code{x}. The created vectors
18+
#' are stored in the servers.
19+
#' @author Demetris Avraam for DataSHIELD Development Team
20+
#' @export
21+
#' @examples
22+
#' \dontrun{
23+
#'
24+
#' # Connecting to the Opal servers
25+
#'
26+
#' require('DSI')
27+
#' require('DSOpal')
28+
#' require('dsBaseClient')
29+
#'
30+
#' builder <- DSI::newDSLoginBuilder()
31+
#' builder$append(server = "study1",
32+
#' url = "http://192.168.56.100:8080/",
33+
#' user = "administrator", password = "datashield_test&",
34+
#' table = "CNSIM.CNSIM1", driver = "OpalDriver")
35+
#' builder$append(server = "study2",
36+
#' url = "http://192.168.56.100:8080/",
37+
#' user = "administrator", password = "datashield_test&",
38+
#' table = "CNSIM.CNSIM2", driver = "OpalDriver")
39+
#' builder$append(server = "study3",
40+
#' url = "http://192.168.56.100:8080/",
41+
#' user = "administrator", password = "datashield_test&",
42+
#' table = "CNSIM.CNSIM3", driver = "OpalDriver")
43+
#'
44+
#' logindata <- builder$build()
45+
#'
46+
#' # Log onto the remote Opal training servers
47+
#' connections <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D")
48+
#'
49+
#' # Example 1: Get the square root of LAB_HDL variable
50+
#' ds.sqrt(x='D$LAB_HDL', newobj='LAB_HDL.sqrt', datasources=connections)
51+
#' # compare the mean of LAB_HDL and of LAB_HDL.sqrt
52+
#' # Note here that the number of missing values is bigger in the LAB_HDL.sqrt
53+
# # vector, because the variable LAB_HDL includes negative values which
54+
# # don't have real square roots and those values are returned as NAs.
55+
#' ds.mean(x='D$LAB_HDL', datasources=connections)
56+
#' ds.mean(x='LAB_HDL.sqrt', datasources=connections)
57+
#'
58+
#' # Example 2: Generate a repeated vector of the squares of integers from 1 to 10
59+
#' # and get their square roots
60+
#' ds.make(toAssign='rep((1:10)^2, times=10)', newobj='squares.vector', datasources=connections)
61+
#' ds.sqrt(x='squares.vector', newobj='sqrt.vector', datasources=connections)
62+
#' # check the behavior of that operation by comparing the tables of squares.vector and sqrt.vector
63+
#' ds.table(rvar='squares.vector')$output.list$TABLE_rvar.by.study_counts
64+
#' ds.table(rvar='sqrt.vector')$output.list$TABLE_rvar.by.study_counts
65+
#'
66+
#' # clear the Datashield R sessions and logout
67+
#' datashield.logout(connections)
68+
#'
69+
#' }
70+
#'
71+
ds.sqrt <- function(x=NULL, newobj=NULL, datasources=NULL){
72+
73+
# look for DS connections
74+
if(is.null(datasources)){
75+
datasources <- datashield.connections_find()
76+
}
77+
78+
if(is.null(x)){
79+
stop("Please provide the name of the input object!", call.=FALSE)
80+
}
81+
82+
# the input variable might be given as column table (i.e. D$x)
83+
# or just as a vector not attached to a table (i.e. x)
84+
# we have to make sure the function deals with each case
85+
xnames <- extract(x)
86+
varname <- xnames$elements
87+
obj2lookfor <- xnames$holders
88+
89+
# check if the input object(s) is(are) defined in all the studies
90+
if(is.na(obj2lookfor)){
91+
defined <- isDefined(datasources, varname)
92+
}else{
93+
defined <- isDefined(datasources, obj2lookfor)
94+
}
95+
96+
# call the internal function that checks the input object is of the same class in all studies.
97+
typ <- checkClass(datasources, x)
98+
99+
# call the internal function that checks the input object(s) is(are) of the same class in all studies.
100+
if(!('numeric' %in% typ) && !('integer' %in% typ)){
101+
stop("Only objects of type 'numeric' or 'integer' are allowed.", call.=FALSE)
102+
}
103+
104+
# create a name by default if the user did not provide a name for the new variable
105+
if(is.null(newobj)){
106+
newobj <- "sqrt.newobj"
107+
}
108+
109+
# call the server side function that does the operation
110+
cally <- call("sqrtDS", x)
111+
DSI::datashield.assign(datasources, newobj, cally)
112+
113+
# check that the new object has been created and display a message accordingly
114+
finalcheck <- isAssigned(datasources, newobj)
115+
116+
}

0 commit comments

Comments
 (0)