Skip to content

Commit d618a20

Browse files
Merge pull request #226 from StuartWheater/v6.0.1-dev_name
Updates for changed 'namesDS' and tests
2 parents be266d1 + 9547579 commit d618a20

File tree

8 files changed

+138
-89
lines changed

8 files changed

+138
-89
lines changed

R/ds.names.R

Lines changed: 46 additions & 48 deletions
Original file line numberDiff line numberDiff line change
@@ -1,87 +1,85 @@
11
#'
2-
#' @title Gets the names of a server-side list
3-
#' @description Function to get the names of an object that is stored on the server-side.
4-
#' @details This function is similar to the R function \code{names}.
5-
#' In DataSHIELD the use of this function is restricted to objects of type list.
6-
#'
7-
#' Server function called: \code{namesDS}
8-
#' @param x a character string specifying the name of the list.
9-
#' @param datasources a list of \code{\link{DSConnection-class}}
10-
#' objects obtained after login. If the \code{datasources} argument is not specified
11-
#' the default set of connections will be used: see \code{\link{datashield.connections_default}}.
2+
#' @title Return the names of a list object
3+
#' @description Returns the names of a designated server-side list
4+
#' @details ds.names calls aggregate function namesDS. This function is similar to
5+
#' the native R function \code{names} but it does not subsume all functionality,
6+
#' for example, it only works to extract names that already exist,
7+
#' not to create new names for objects. The function is restricted to objects of
8+
#' type list, but this includes objects that have a primary class other than list but which
9+
#' return TRUE to the native R function {is.list}. As an example this includes
10+
#' the multi-component object created by fitting a generalized linear model
11+
#' using ds.glmSLMA. The resultant object saved on each server separately
12+
#' is formally of class "glm" and "ls" but responds TRUE to is.list(),
13+
#' @param xname a character string specifying the name of the list.
14+
#' @param datasources a list of \code{\link{DSConnection-class}}
15+
#' objects obtained after login that represent the particular data sources
16+
#' (studies) to be addressed by the function call. If the \code{datasources}
17+
#' argument is not specified the default set of connections will be used:
18+
#' see \code{\link{datashield.connections_default}}.
1219
#' @return \code{ds.names} returns to the client-side the names
13-
#' of a list stored on the server-side.
14-
#' @author DataSHIELD Development Team
20+
#' of a list object stored on the server-side.
21+
#' @author Amadou Gaye, updated by Paul Burton for DataSHIELD development
22+
#' team 25/06/2020
1523
#' @export
1624
#' @examples
1725
#' \dontrun{
18-
#'
26+
#'
1927
#' ## Version 6, for version 5 see the Wiki
20-
#'
28+
#'
2129
#' # connecting to the Opal servers
22-
#'
30+
#'
2331
#' require('DSI')
2432
#' require('DSOpal')
2533
#' require('dsBaseClient')
2634
#'
2735
#' builder <- DSI::newDSLoginBuilder()
28-
#' builder$append(server = "study1",
29-
#' url = "http://192.168.56.100:8080/",
30-
#' user = "administrator", password = "datashield_test&",
36+
#' builder$append(server = "study1",
37+
#' url = "http://192.168.56.100:8080/",
38+
#' user = "administrator", password = "datashield_test&",
3139
#' table = "CNSIM.CNSIM1", driver = "OpalDriver")
32-
#' builder$append(server = "study2",
33-
#' url = "http://192.168.56.100:8080/",
34-
#' user = "administrator", password = "datashield_test&",
40+
#' builder$append(server = "study2",
41+
#' url = "http://192.168.56.100:8080/",
42+
#' user = "administrator", password = "datashield_test&",
3543
#' table = "CNSIM.CNSIM2", driver = "OpalDriver")
3644
#' builder$append(server = "study3",
37-
#' url = "http://192.168.56.100:8080/",
38-
#' user = "administrator", password = "datashield_test&",
45+
#' url = "http://192.168.56.100:8080/",
46+
#' user = "administrator", password = "datashield_test&",
3947
#' table = "CNSIM.CNSIM3", driver = "OpalDriver")
4048
#' logindata <- builder$build()
41-
#'
42-
#' connections <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D")
43-
#'
44-
#' #Create a list in the server-side
45-
#'
49+
#'
50+
#' connections <- DSI::datashield.login(logins = logindata, assign = TRUE, symbol = "D")
51+
#'
52+
#' #Create a list in the server-side
53+
#'
4654
#' ds.asList(x.name = "D",
4755
#' newobj = "D.list",
4856
#' datasources = connections)
49-
#'
57+
#'
5058
#' #Get the names of the list
51-
#'
52-
#' ds.names(x = "D.list",
59+
#'
60+
#' ds.names(xname = "D.list",
5361
#' datasources = connections)
5462
#'
55-
#'
63+
#'
5664
#' # clear the Datashield R sessions and logout
5765
#' datashield.logout(connections)
5866
#'
5967
#' }
6068
#'
61-
ds.names <- function(x=NULL, datasources=NULL){
69+
ds.names <- function(xname=NULL, datasources=NULL){
6270

6371
# look for DS connections
6472
if(is.null(datasources)){
6573
datasources <- datashield.connections_find()
6674
}
6775

68-
if(is.null(x)){
76+
if(is.null(xname)){
6977
stop("Please provide the name of the input list!", call.=FALSE)
70-
}else{
71-
defined <- isDefined(datasources, x)
72-
}
73-
74-
# call the internal function that checks the input object is of the same class in all studies.
75-
typ <- checkClass(datasources, x)
76-
77-
# the input object must be a list
78-
if(!('list' %in% typ)){
79-
stop("The input object must be a list.", call.=FALSE)
8078
}
8179

82-
# call the server side function that does the job.
83-
cally <- paste0('namesDS(', x, ')')
84-
output <- DSI::datashield.aggregate(datasources, as.symbol(cally))
80+
calltext<-call("namesDS", xname)
81+
output<-datashield.aggregate(datasources,calltext)
8582
return(output)
86-
8783
}
84+
85+
#ds.names

R/ds.summary.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -174,7 +174,7 @@ ds.summary <- function(x=NULL, datasources=NULL){
174174
if("list" %in% typ){
175175
for(i in 1:numsources){
176176
l <- DSI::datashield.aggregate(datasources[i], call('lengthDS', x))[[1]]
177-
elts <- DSI::datashield.aggregate(datasources[i], as.symbol(paste0('namesDS(', x, ')' )))[[1]]
177+
elts <- DSI::datashield.aggregate(datasources[i], call('namesDS', x))[[1]]
178178
if(is.null(elts)){
179179
stdsummary <- list('class'=typ, 'length'=l)
180180
}else{

R/meanByClassHelper4.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,8 +26,8 @@ meanByClassHelper4 <- function(dtsource, alist, initialtable, variable=NA, categ
2626
newsubsets <- append(newsubsets, name2use)
2727
}
2828
}else{
29-
cally <- paste0('namesDS(', alist, ')')
30-
subsetnames <- unique(unlist(DSI::datashield.aggregate(dtsource, as.symbol(cally))))
29+
cally <- call('namesDS', alist)
30+
subsetnames <- unique(unlist(DSI::datashield.aggregate(dtsource, cally)))
3131
for(m in 1:length(subsetnames)){
3232
name2use <- paste0(unlist(strsplit(paste0(initialtable,'.',subsetnames[m]), '.level_')), collapse='')
3333
DSI::datashield.assign(dtsource, name2use, as.symbol(paste0(alist,'$',subsetnames[m])))

man/ds.names.Rd

Lines changed: 39 additions & 31 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

tests/testthat/test-arg-ds.names.R

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,15 @@ connect.studies.dataset.cnsim(list("LAB_TSC"))
2121
context("ds.names::arg::test errors")
2222
test_that("simple ds.names errors", {
2323
expect_error(ds.names(), "Please provide the name of the input list!", fixed=TRUE)
24-
expect_error(ds.names(x="D$LAB_TSC"), "The input object must be a list.", fixed=TRUE)
24+
25+
res <- ds.names(x="D$LAB_TSC")
26+
27+
expect_length(res, 3)
28+
expect_length(res$sim1, 2)
29+
expect_length(res$sim1$error.message, 1)
30+
expect_equal(res$sim1$error.message, "The input object is not of class <list>", fixed=TRUE)
31+
expect_length(res$sim1$trace.message, 1)
32+
expect_equal(res$sim1$trace.message, "numeric")
2533
})
2634

2735
#

tests/testthat/test-smk-ds.listServersideFunctions.R

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ test_that("check results", {
3333
"tableDS.assign", "tapplyDS.assign", "unlist", "unListDS"
3434
))
3535
aggregate.functions <- factor(c(
36-
"NROW", "alphaPhiDS", "asFactorDS1", "asListDS",
36+
"NROW", "asFactorDS1", "asListDS",
3737
"checkNegValueDS", "classDS", "colnamesDS", "corTestDS",
3838
"covDS", "dataFrameSubsetDS1",
3939
"densityGridDS", "dimDS",

tests/testthat/test-smk-ds.subsetByClass.R

Lines changed: 23 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,12 +25,31 @@ test_that("setup", {
2525
#
2626

2727
context("ds.subsetByClass::smk")
28-
test_that("gender", {
29-
res <- ds.subsetByClass(x='D', subsets='subclasses')
28+
test_that("gender implicit", {
29+
res <- ds.subsetByClass(x='D', subsets='subclasses1')
3030

3131
expect_true(is.null(res))
3232

33-
check <- ds.names('subclasses')
33+
check <- ds.names('subclasses1')
34+
35+
expect_length(check, 3)
36+
expect_length(check$sim1, 2)
37+
expect_equal(check$sim1[1], 'GENDER.level_0')
38+
expect_equal(check$sim1[2], 'GENDER.level_1')
39+
expect_length(check$sim2, 2)
40+
expect_equal(check$sim2[1], 'GENDER.level_0')
41+
expect_equal(check$sim2[2], 'GENDER.level_1')
42+
expect_length(check$sim3, 2)
43+
expect_equal(check$sim3[1], 'GENDER.level_0')
44+
expect_equal(check$sim3[2], 'GENDER.level_1')
45+
})
46+
47+
test_that("gender explicit", {
48+
res <- ds.subsetByClass(x='D', subsets='subclasses2', variables='GENDER')
49+
50+
expect_true(is.null(res))
51+
52+
check <- ds.names('subclasses2')
3453

3554
expect_length(check, 3)
3655
expect_length(check$sim1, 2)
@@ -51,7 +70,7 @@ test_that("gender", {
5170
context("ds.subsetByClass::smk::shutdown")
5271

5372
test_that("shutdown", {
54-
ds_expect_variables(c("D", "subclasses"))
73+
ds_expect_variables(c("D", "subclasses1", "subclasses2"))
5574
})
5675

5776
disconnect.studies.dataset.cnsim()

tests/testthat/test-smk-ds.summary.R

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -68,6 +68,22 @@ test_that("summary_factor_variable", {
6868
expect_equal(res$sim3$`count of '3'`, 1154)
6969
})
7070

71+
context("ds.summary::smk::summary of a list variable")
72+
ds.asList(x.name='D$PM_BMI_CATEGORICAL', newobj="a_list")
73+
res <- ds.summary(x='a_list')
74+
test_that("summary_list_variable", {
75+
expect_length(res, 3)
76+
expect_length(res$sim1, 2)
77+
expect_equal(res$sim1$class, "list")
78+
expect_equal(res$sim1$length, 2163)
79+
expect_length(res$sim2, 2)
80+
expect_equal(res$sim2$class, "list")
81+
expect_equal(res$sim2$length, 3088)
82+
expect_length(res$sim3, 2)
83+
expect_equal(res$sim3$class, "list")
84+
expect_equal(res$sim3$length, 4128)
85+
})
86+
7187
context("ds.summary::smk::summary of a data frame")
7288
res <- ds.summary(x='D')
7389
test_that("summary_data_frame", {
@@ -85,7 +101,7 @@ test_that("summary_data_frame", {
85101
context("ds.summary::smk::teardown")
86102

87103
test_that("shutdown", {
88-
ds_expect_variables(c("D", "a_character", "a_factor"))
104+
ds_expect_variables(c("D", "a_character", "a_factor", "a_list"))
89105
})
90106

91107
disconnect.studies.dataset.cnsim()

0 commit comments

Comments
 (0)