Skip to content

Commit fa7d19e

Browse files
alexwesterbergalexwesterberg
committed
First draft at glmPredict smoke testing
1 parent 2bec2b2 commit fa7d19e

1 file changed

Lines changed: 124 additions & 0 deletions

File tree

‎tests/testthat/test-arg-ds.glmPredict.R‎

Lines changed: 124 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,124 @@
1+
#-------------------------------------------------------------------------------
2+
# Copyright (c) 2018-2020 University of Newcastle upon Tyne. All rights reserved.
3+
#
4+
# This program and the accompanying materials
5+
# are made available under the terms of the GNU Public License v3.0.
6+
#
7+
# You should have received a copy of the GNU General Public License
8+
# along with this program. If not, see <http://www.gnu.org/licenses/>.
9+
#-------------------------------------------------------------------------------
10+
11+
#
12+
# Set up
13+
#
14+
15+
connect.studies.dataset.cnsim(list("LAB_TSC", "LAB_TRIG", "DIS_AMI", "DIS_DIAB", "GENDER"))
16+
17+
#
18+
# Tests
19+
#
20+
21+
context("ds.glmPredict::arg::test _glmname_ arg is correct object")
22+
test_that("glmPredict_errors", {
23+
res<-ds.glmPredict()
24+
expect_equal(res, "<glmname> is not set, please specify it as a character string containing the name of a valid glm class object on the serverside", fixed=TRUE)
25+
26+
#expect_error(ds.glmPredict(), " Please provide a valid 'family' argument!", fixed=TRUE)
27+
#res<-ds.glmPredict(ABC)
28+
#expect_equal(res, "object 'ABC' not found", fixed=TRUE)
29+
expect_error(ds.glmPredict("ABC"), "There are some DataSHIELD errors, list them with datashield.errors()", fixed=TRUE)
30+
# TODO: "some DataSHIELD errors" is unhelpful and needs improvement
31+
expect_equal(class(datashield.errors()),"list")
32+
expect_length(datashield.errors(),3)
33+
expect_equal(names(datashield.errors()),c("sim1","sim2","sim3"))
34+
})
35+
36+
context("ds.glmPredict::arg::setting up glm obj for further testing")
37+
test_that("glmPredict_errors", {
38+
#glm.obj <- ds.glmSLMA('D$LAB_TSC~D$LAB_TSC', family="gaussian", newobj="gaussian.glmslma.obj")
39+
#glmSLMA.res <- ds.glmSLMA('D$DIS_DIAB~D$LAB_TRIG', family="binomial", newobj="binomial.glmslma.obj")
40+
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
41+
42+
expect_length(glmSLMA.res, 9)
43+
expect_equal(glmSLMA.res$num.valid.studies, 3)
44+
expect_length(glmSLMA.res$validity.check, 1)
45+
expect_equal(glmSLMA.res$validity.check, "<gaussian.glmslma.obj> appears valid in all sources")
46+
})
47+
48+
context("ds.glmPredict::arg::test _newdataname_ arg is correct object")
49+
test_that("glmPredict_errors", {
50+
expect_error(ds.glmPredict("gaussian.glmslma.obj", newdataname = "help"),"There are some DataSHIELD errors, list them with datashield.errors()")
51+
# TODO: "some DataSHIELD errors" is unhelpful and needs improvement
52+
expect_equal(class(datashield.errors()),"list")
53+
expect_length(datashield.errors(),3)
54+
expect_equal(names(datashield.errors()),c("sim1","sim2","sim3"))
55+
})
56+
57+
context("ds.glmPredict::arg::test _output.type_ arg is correct object")
58+
test_that("glmPredict_errors", {
59+
expect_error(ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = NULL), "missing value where TRUE/FALSE needed")
60+
# TODO: "true/false" is wrong message to get here, error message needs to be fixed
61+
res<-ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = 'blah')
62+
expect_equal(res,"<output.type> is not correctly set, please specify it as one of three character strings: 'link', 'response', or 'terms'")
63+
64+
})
65+
66+
context("ds.glmPredict::arg::test _se.fit_ arg is correct object")
67+
test_that("glmPredict_errors", {
68+
expect_error(ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = "1"), "There are some DataSHIELD errors, list them with datashield.errors()")
69+
70+
expect_equal(class(datashield.errors()),"list")
71+
expect_length(datashield.errors(),3)
72+
expect_equal(names(datashield.errors()),c("sim1","sim2","sim3"))
73+
})
74+
75+
context("ds.glmPredict::arg::test _dispersion_ arg is correct object")
76+
test_that("glmPredict_errors", {
77+
# res<-ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = FALSE, dispersion = "thereisnothingontheservercalledthis")
78+
# TODO: why is dispersion passing nonsensical values without questioning it? needs error message
79+
})
80+
81+
context("ds.glmPredict::arg::test _terms_ arg is correct object")
82+
test_that("glmPredict_errors", {
83+
expect_error(ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "terms", se.fit = FALSE, dispersion = NULL, terms="thereisnothingontheservercalledthis2"), "There are some DataSHIELD errors, list them with datashield.errors()")
84+
85+
# TODO: "some DataSHIELD errors" is unhelpful and needs improvement
86+
expect_equal(class(datashield.errors()),"list")
87+
expect_length(datashield.errors(),3)
88+
expect_equal(names(datashield.errors()),c("sim1","sim2","sim3"))
89+
})
90+
91+
context("ds.glmPredict::arg::test _na.action_ arg is correct object")
92+
test_that("glmPredict_errors", {
93+
res<-ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = FALSE, dispersion = NULL, terms=NULL, na.action= "na.other")
94+
expect_equal(res, "<na.action> is not correctly set, please specify it as one of four character strings: 'na.fail', 'na.omit', 'na.exclude' or 'na.pass'")
95+
})
96+
97+
98+
context("ds.glmPredict::arg::test _newobj_ arg is correct object")
99+
test_that("glmPredict_errors", {
100+
# TODO: come up with a way to create an invalid object to then test newobj argument
101+
# res<-ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = FALSE, dispersion = NULL, terms=NULL, na.action= "na.other")
102+
# print(res)
103+
})
104+
105+
106+
#
107+
# Done
108+
#
109+
110+
disconnect.studies.dataset.cnsim()
111+
112+
113+
#res.errors<-datashield.errors()
114+
115+
#expect_length(res.errors, 3)
116+
#expect_equal(res.errors[[1]], "Command 'glmSLMADS1(D$LAB_TSC ~ D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' failed on 'sim1': Error while evaluating 'dsBase::glmSLMADS1(D$LAB_TSC~D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' -> Error in model.frame.default(formula = formula2use, data = dataTable, : \n invalid type (NULL) for variable 'D$LAB_TRIG'\n", fixed=TRUE)
117+
#expect_equal(res.errors[[2]], "Command 'glmSLMADS1(D$LAB_TSC ~ D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' failed on 'sim2': Error while evaluating 'dsBase::glmSLMADS1(D$LAB_TSC~D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' -> Error in model.frame.default(formula = formula2use, data = dataTable, : \n invalid type (NULL) for variable 'D$LAB_TRIG'\n", fixed=TRUE)
118+
#expect_equal(res.errors[[3]], "Command 'glmSLMADS1(D$LAB_TSC ~ D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' failed on 'sim3': Error while evaluating 'dsBase::glmSLMADS1(D$LAB_TSC~D$LAB_TRIG, \"gaussian\", NULL, NULL, NULL)' -> Error in model.frame.default(formula = formula2use, data = dataTable, : \n invalid type (NULL) for variable 'D$LAB_TRIG'\n", fixed=TRUE)
119+
#expect_length(glm.obj$validity.check, 1)
120+
#expect_equal(glm.obj$validity.check, "<binomial.glmslma.obj> appears valid in all sources")
121+
122+
#res <- ds.glmPredict("gaussian.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = FALSE, na.action = "na.pass")
123+
#res <- ds.glmPredict("gaussian.glmslma.obj")
124+
#print(res)

0 commit comments

Comments
 (0)