Skip to content

Commit c044c30

Browse files
StuartWheaterStuartWheater
authored
Merge pull request #236 from StuartWheater/v6.1-dev_glmsummary
Fixed use of 'newobj', improved tests, update manual
2 parents 923612e + a7ce9f9 commit c044c30

3 files changed

Lines changed: 82 additions & 19 deletions

File tree

‎R/ds.glmSummary.R‎

Lines changed: 17 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
#' @title summarize a glm object on the serverside
33
#' @description summarize a glm object on the serverside to create a
44
#' summary_glm object. Also identify and return components of
5-
#' both the glm object and the summary_glm object
5+
#' both the glm object and the summary_glm object
66
#' that can safely be sent to the clientside without a risk of disclosure
77
#' @details Clientside function calling a single assign function (glmSummaryDS.as)
88
#' and a single aggregate function (glmSummaryDS.as). ds.glmSummary summarises a
@@ -38,7 +38,7 @@
3838
#' @param newobj a character string specifying the name of the object to which
3939
#' the summary_glm object representing the output of summary(glm object)
4040
#' in each study is to be written. If no <newobj> argument is specified, the output
41-
#' object on the serverside defaults to "summary_glm".
41+
#' object on the serverside defaults to "summary_glm.newobj".
4242
#' @param datasources specifies the particular 'connection object(s)' to use.
4343
#' e.g. if you have several data sets in the sources you are working with
4444
#' called opals.a, opals.w2, and connection.xyz, you can choose which of
@@ -94,7 +94,9 @@ ds.glmSummary<-function(x.name, newobj=NULL, datasources=NULL) {
9494
#FORCE newobj TO BE CORRECT IN CASE USER TRIES TO SPECIFY A VALUE FOR IT
9595
#NAME OF ALL THREE newobj OBJECTS IS DEFINED FULLY BY x.name
9696

97-
newobj<- "summary_glm"
97+
if (is.null(newobj)) {
98+
newobj<- "summary_glm.newobj"
99+
}
98100

99101
calltext1 <- call("glmSummaryDS.as", x.name)
100102

@@ -129,7 +131,7 @@ for(j in 1:num.datasources){ #
129131
if(!object.info[[j]]$test.obj.exists){ #
130132
obj.name.exists.in.all.sources<-FALSE #
131133
} #
132-
if(object.info[[j]]$test.obj.class=="ABSENT"){ #
134+
if(is.null(object.info[[j]]$test.obj.class) || object.info[[j]]$test.obj.class=="ABSENT"){ #
133135
obj.non.null.in.all.sources<-FALSE #
134136
} #
135137
} #
@@ -167,18 +169,18 @@ if(obj.name.exists.in.all.sources && obj.non.null.in.all.sources){ #
167169
} #
168170
#
169171
#
170-
if(no.errors){ #
171-
cat("\n\nCREATE ASSIGN OBJECT\n") #
172-
#
173-
validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") #
174-
print(list(is.object.created=return.message,validity.check=validity.check)) #
175-
} #
172+
# if(no.errors){ #
173+
# cat("\n\nCREATE ASSIGN OBJECT\n") #
174+
# #
175+
# validity.check<-paste0("<",test.obj.name, "> appears valid in all sources") #
176+
# print(list(is.object.created=return.message,validity.check=validity.check)) #
177+
# } #
176178
#
177-
if(!no.errors){ #
178-
validity.check<-paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:") #
179-
print(list(is.object.created=return.message,validity.check=validity.check, #
180-
studyside.messages=studyside.message)) #
181-
} #
179+
if(!no.errors){ #
180+
validity.check<-paste0("<",test.obj.name,"> invalid in at least one source. See studyside.messages:") #
181+
print(list(is.object.created=return.message,validity.check=validity.check, #
182+
studyside.messages=studyside.message)) #
183+
} #
182184
#
183185
#END OF CHECK OBJECT CREATED CORECTLY MODULE #
184186
#############################################################################################################

‎man/ds.glmSummary.Rd‎

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

‎tests/testthat/test-smk-ds.glmSummary.R‎

Lines changed: 63 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,37 @@ test_that("setup", {
2525
#
2626

2727
context("ds.glmSummary::smk::gaussian")
28+
test_that("simple glmSummary, gaussian, without newobj", {
29+
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
30+
31+
expect_length(glmSLMA.res, 9)
32+
expect_equal(glmSLMA.res$num.valid.studies, 3)
33+
expect_length(glmSLMA.res$validity.check, 1)
34+
expect_equal(glmSLMA.res$validity.check, "<gaussian.glmslma.obj> appears valid in all sources")
35+
36+
res <- ds.glmSummary("gaussian.glmslma.obj")
37+
38+
expect_length(res, 3)
39+
expect_length(res$sim1, 2)
40+
expect_length(res$sim1$glm.obj, 31)
41+
expect_true('glm' %in% class(res$sim1$glm.obj))
42+
expect_true('lm' %in% class(res$sim1$glm.obj))
43+
expect_length(res$sim1$glm.summary.obj, 18)
44+
expect_equal(class(res$sim1$glm.summary.obj), 'summary.glm')
45+
expect_length(res$sim2, 2)
46+
expect_length(res$sim2$glm.obj, 31)
47+
expect_true('glm' %in% class(res$sim2$glm.obj))
48+
expect_true('lm' %in% class(res$sim2$glm.obj))
49+
expect_length(res$sim2$glm.summary.obj, 18)
50+
expect_equal(class(res$sim2$glm.summary.obj), 'summary.glm')
51+
expect_length(res$sim3, 2)
52+
expect_length(res$sim3$glm.obj, 31)
53+
expect_true('glm' %in% class(res$sim3$glm.obj))
54+
expect_true('lm' %in% class(res$sim3$glm.obj))
55+
expect_length(res$sim3$glm.summary.obj, 18)
56+
expect_equal(class(res$sim3$glm.summary.obj), 'summary.glm')
57+
})
58+
2859
test_that("simple glmSummary, gaussian", {
2960
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
3061

@@ -57,6 +88,37 @@ test_that("simple glmSummary, gaussian", {
5788
})
5889

5990
context("ds.glmSummary::smk::poisson")
91+
test_that("simple glmSummary, poisson, without newobj", {
92+
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="poisson", newobj="poisson.glmslma.obj")
93+
94+
expect_length(glmSLMA.res, 9)
95+
expect_equal(glmSLMA.res$num.valid.studies, 3)
96+
expect_length(glmSLMA.res$validity.check, 1)
97+
expect_equal(glmSLMA.res$validity.check, "<poisson.glmslma.obj> appears valid in all sources")
98+
99+
res <- ds.glmSummary("poisson.glmslma.obj")
100+
101+
expect_length(res, 3)
102+
expect_length(res$sim1, 2)
103+
expect_length(res$sim1$glm.obj, 31)
104+
expect_true('glm' %in% class(res$sim1$glm.obj))
105+
expect_true('lm' %in% class(res$sim1$glm.obj))
106+
expect_length(res$sim1$glm.summary.obj, 18)
107+
expect_equal(class(res$sim1$glm.summary.obj), 'summary.glm')
108+
expect_length(res$sim2, 2)
109+
expect_length(res$sim2$glm.obj, 31)
110+
expect_true('glm' %in% class(res$sim2$glm.obj))
111+
expect_true('lm' %in% class(res$sim2$glm.obj))
112+
expect_length(res$sim2$glm.summary.obj, 18)
113+
expect_equal(class(res$sim2$glm.summary.obj), 'summary.glm')
114+
expect_length(res$sim3, 2)
115+
expect_length(res$sim3$glm.obj, 31)
116+
expect_true('glm' %in% class(res$sim3$glm.obj))
117+
expect_true('lm' %in% class(res$sim3$glm.obj))
118+
expect_length(res$sim3$glm.summary.obj, 18)
119+
expect_equal(class(res$sim3$glm.summary.obj), 'summary.glm')
120+
})
121+
60122
test_that("simple glmSummary, poisson", {
61123
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="poisson", newobj="poisson.glmslma.obj")
62124

@@ -95,8 +157,7 @@ test_that("simple glmSummary, poisson", {
95157
context("ds.glmSummary::smk::shutdown")
96158

97159
test_that("shutdown", {
98-
# ds_expect_variables(c("D", "gaussian.glmslma.obj", "gaussian.glmsummary.obj", "poisson.glmslma.obj", "poisson.glmsummary.obj"))
99-
ds_expect_variables(c("D", "gaussian.glmslma.obj", "poisson.glmslma.obj", "summary_glm"))
160+
ds_expect_variables(c("D", "gaussian.glmslma.obj", "gaussian.glmsummary.obj", "poisson.glmslma.obj", "poisson.glmsummary.obj", "summary_glm.newobj"))
100161
})
101162

102163
disconnect.studies.dataset.cnsim()

0 commit comments

Comments
 (0)