Skip to content

Commit 2315365

Browse files
StuartWheaterStuartWheater
authored
Merge pull request #292 from alexwesterberg/v6.1-dev
Additions to glm tests plus documentation tidying
2 parents fdbb295 + 27f9934 commit 2315365

10 files changed

Lines changed: 152 additions & 15 deletions

‎R/ds.glmPredict.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
#ds.glmPredict
2-
#' @title applies predict.glm() to a serverside glm object
3-
#' @description apply native R's predict.glm() function to a serverside
2+
#' @title Applies predict.glm() to a serverside glm object
3+
#' @description Applies native R's predict.glm() function to a serverside
44
#' glm object previously created using ds.glmSLMA.
55
#' @details Clientside function calling a single assign function (glmPredictDS.as)
66
#' and a single aggregate function (glmPredictDS.ag). ds.glmPredict applies

‎R/ds.scatterPlot.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -44,8 +44,8 @@
4444
#' study is generated.
4545
#'
4646
#' Server function called: \code{scatterPlotDS}
47-
#' @param x a character string specifying the name of a numeric vector.
48-
#' @param y a character string specifying the name of a numeric vector.
47+
#' @param x a character string specifying the name of the explanatory variable, a numeric vector.
48+
#' @param y a character string specifying the name of the response variable, a numeric vector.
4949
#' @param method a character string that specifies the
5050
#' method that is used to generated non-disclosive
5151
#' coordinates to be displayed in a scatter plot.

‎man/ds.glmPredict.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.

‎man/ds.scatterPlot.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-arg-ds.glm.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ connect.studies.dataset.cnsim(list("LAB_TSC"))
1919
#
2020

2121
context("ds.glm::arg::test errors")
22-
test_that("glm_erros", {
22+
test_that("glm_errors", {
2323
expect_error(ds.glm(), " Please provide a valid regression formula!", fixed=TRUE)
2424
expect_error(ds.glm("D$LAB_TSC~D$LAB_TSC"), " Please provide a valid 'family' argument!", fixed=TRUE)
2525
})

‎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)

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

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -19,8 +19,16 @@ connect.studies.dataset.cnsim(list("LAB_TSC"))
1919
#
2020

2121
context("ds.glmSLMA::arg::test errors")
22-
test_that("glmSLMA_erros", {
23-
expect_error(ds.glmSLMA(), " Please provide a valid regression formula!", fixed=TRUE)
22+
test_that("glmSLMA_errors", {
23+
expect_error(ds.glmSLMA(), " Please provide a valid regression formula!", fixed=TRUE)
24+
25+
expect_error(ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj"), "There are some DataSHIELD errors, list them with datashield.errors()", fixed=TRUE)
26+
res.errors<-datashield.errors()
27+
expect_length(res.errors, 3)
28+
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)
29+
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)
30+
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)
31+
2432
})
2533

2634
#

‎tests/testthat/test-smk-ds.glmPredict-binomial.R‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ test_that("setup", {
2424
# Tests
2525
#
2626

27-
context("ds.glmPredict::smk::binomial")
27+
context("ds.glmPredict::smk::binomial::without_newobj")
2828
test_that("simple glmPredict, binomial, without newobj, se.fit=FALSE",{
2929
glmSLMA.res <- ds.glmSLMA('D$DIS_DIAB~D$LAB_TRIG', family="binomial", newobj="binomial.glmslma.obj")
3030

@@ -106,6 +106,7 @@ test_that("simple glmPredict, binomial, without newobj, se.fit=FALSE",{
106106

107107
})
108108

109+
context("ds.glmPredict::smk::binomial::with_newobj")
109110
test_that("simple glmPredict, binomial, with newobj, se.fit=FALSE", {
110111
glmSLMA.res <- ds.glmSLMA('D$DIS_DIAB~D$LAB_TRIG', family="binomial", newobj="binomial.glmslma.obj")
111112

@@ -186,6 +187,7 @@ test_that("simple glmPredict, binomial, with newobj, se.fit=FALSE", {
186187
expect_equal(res$sim3$safe.list$fit.quantiles[[7]], 0.029020811, tolerance = 1e-7)
187188
})
188189

190+
context("ds.glmPredict::smk::binomial::sefit_true")
189191
test_that("simple glmPredict, binomial, with newobj, se.fit=TRUE", {
190192
glmSLMA.res <- ds.glmSLMA('D$DIS_DIAB~D$LAB_TRIG', family="binomial", newobj="binomial.glmslma.obj")
191193

‎tests/testthat/test-smk-ds.glmPredict-gaussian.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,7 @@ test_that("setup", {
2323
#
2424
# Tests
2525
#
26-
27-
context("ds.glmPredict::smk::gaussian")
26+
context("ds.glmPredict::smk::gaussian::without_newobj")
2827
test_that("simple glmPredict, gaussian, without newobj, se.fit=FALSE",{
2928
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
3029

@@ -105,6 +104,7 @@ test_that("simple glmPredict, gaussian, without newobj, se.fit=FALSE",{
105104
expect_equal(res$sim3$safe.list$fit.quantiles[[7]], 6.054574, tolerance = 1e-7)
106105
})
107106

107+
context("ds.glmPredict::smk::gaussian::with_newobj")
108108
test_that("simple glmPredict, gaussian, with newobj, se.fit=FALSE", {
109109
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
110110

@@ -185,6 +185,7 @@ test_that("simple glmPredict, gaussian, with newobj, se.fit=FALSE", {
185185
expect_equal(res$sim3$safe.list$fit.quantiles[[7]], 6.054574, tolerance = 1e-7)
186186
})
187187

188+
context("ds.glmPredict::smk::gaussian::sefit_true")
188189
test_that("simple glmPredict, gaussian, with newobj, se.fit=TRUE", {
189190
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="gaussian", newobj="gaussian.glmslma.obj")
190191

‎tests/testthat/test-smk-ds.glmPredict-poisson.R‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ test_that("setup", {
2424
# Tests
2525
#
2626

27-
context("ds.glmPredict::smk::poisson")
27+
context("ds.glmPredict::smk::poisson::without_newobj")
2828
test_that("simple glmPredict, poisson, without newobj, se.fit=FALSE", {
2929
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="poisson", newobj="poisson.glmslma.obj")
3030

@@ -105,6 +105,7 @@ test_that("simple glmPredict, poisson, without newobj, se.fit=FALSE", {
105105
expect_equal(res$sim3$safe.list$fit.quantiles[[7]], 6.056664, tolerance = 1e-7)
106106
})
107107

108+
context("ds.glmPredict::smk::poisson::with_newobj")
108109
test_that("simple glmPredict, poisson, with newobj, se.fit=FALSE", {
109110
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="poisson", newobj="poisson.glmslma.obj")
110111

@@ -185,6 +186,7 @@ test_that("simple glmPredict, poisson, with newobj, se.fit=FALSE", {
185186
expect_equal(res$sim3$safe.list$fit.quantiles[[7]], 6.056664, tolerance = 1e-7)
186187
})
187188

189+
context("ds.glmPredict::smk::poisson::sefit_true")
188190
test_that("simple glmPredict, poisson, with newobj, se.fit=TRUE", {
189191
glmSLMA.res <- ds.glmSLMA('D$LAB_TSC~D$LAB_TRIG', family="poisson", newobj="poisson.glmslma.obj")
190192

0 commit comments

Comments
 (0)