Skip to content

Commit 42a20f2

Browse files
alexwesterbergalexwesterberg
authored
Merge pull request #9 from datashield/v6.1-dev
V6.1 dev
2 parents 2245406 + b5edcc3 commit 42a20f2

8 files changed

Lines changed: 344 additions & 77 deletions

‎tests/testthat/test-datachk-DISCORDANT.R‎

Lines changed: 134 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,134 @@
1+
#-------------------------------------------------------------------------------
2+
# Copyright (c) 2019-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+
context("DISCORDANT::datachk::setup")
16+
17+
connect.discordant.dataset.simple(list('A', 'B', 'C'))
18+
19+
test_that("setup", {
20+
ds_expect_variables(c("D"))
21+
})
22+
23+
#
24+
# Tests
25+
#
26+
27+
context("DISCORDANT::datachk")
28+
test_that("Check DISCORDANT dataset", {
29+
res.class <- ds.class(x='D')
30+
expect_length(res.class, 3)
31+
expect_length(res.class$discordant1, 1)
32+
expect_equal(res.class$discordant1, "data.frame")
33+
expect_length(res.class$discordant2, 1)
34+
expect_equal(res.class$discordant2, "data.frame")
35+
expect_length(res.class$discordant3, 1)
36+
expect_equal(res.class$discordant3, "data.frame")
37+
38+
res.length <- ds.length(x='D')
39+
expect_length(res.length, 4)
40+
expect_length(res.length$`length of D in discordant1`, 1)
41+
expect_equal(res.length$`length of D in discordant1`, 2)
42+
expect_length(res.length$`length of D in discordant2`, 1)
43+
expect_equal(res.length$`length of D in discordant2`, 2)
44+
expect_length(res.length$`length of D in discordant3`, 1)
45+
expect_equal(res.length$`length of D in discordant3`, 2)
46+
expect_equal(res.length$`total length of D in all studies combined`, 6)
47+
48+
res.colnames <- ds.colnames(x='D')
49+
expect_length(res.colnames, 3)
50+
expect_length(res.colnames$discordant1, 2)
51+
expect_equal(res.colnames$discordant1, c('A', 'B'))
52+
expect_length(res.colnames$discordant2, 2)
53+
expect_equal(res.colnames$discordant2, c('A', 'C'))
54+
expect_length(res.colnames$discordant3, 2)
55+
expect_equal(res.colnames$discordant3, c('B', 'C'))
56+
57+
res.class.a <- ds.class(x='D$A')
58+
expect_length(res.class.a, 3)
59+
expect_length(res.class.a$discordant1, 1)
60+
expect_equal(res.class.a$discordant1, "integer")
61+
expect_length(res.class.a$discordant2, 1)
62+
expect_equal(res.class.a$discordant2, "integer")
63+
expect_length(res.class.a$discordant3, 1)
64+
expect_equal(res.class.a$discordant3, "NULL")
65+
66+
res.length.a <- ds.length(x='D$A')
67+
expect_length(res.length.a, 4)
68+
expect_length(res.length.a$`length of D$A in discordant1`, 1)
69+
expect_equal(res.length.a$`length of D$A in discordant1`, 12)
70+
expect_length(res.length.a$`length of D$A in discordant2`, 1)
71+
expect_equal(res.length.a$`length of D$A in discordant2`, 12)
72+
expect_length(res.length.a$`length of D$A in discordant3`, 1)
73+
expect_equal(res.length.a$`length of D$A in discordant3`, 0)
74+
expect_length(res.length.a$`total length of D$A in all studies combined`, 1)
75+
expect_equal(res.length.a$`total length of D$A in all studies combined`, 24)
76+
77+
res.class.b <- ds.class(x='D$B')
78+
expect_length(res.class.b, 3)
79+
expect_length(res.class.b$discordant1, 1)
80+
expect_equal(res.class.b$discordant1, "integer")
81+
expect_length(res.class.b$discordant2, 1)
82+
expect_equal(res.class.b$discordant2, "NULL")
83+
expect_length(res.class.b$discordant3, 1)
84+
expect_equal(res.class.b$discordant3, "integer")
85+
86+
res.length.b <- ds.length(x='D$B')
87+
expect_length(res.length.b, 4)
88+
expect_length(res.length.b$`length of D$B in discordant1`, 1)
89+
expect_equal(res.length.b$`length of D$B in discordant1`, 12)
90+
expect_length(res.length.b$`length of D$B in discordant2`, 1)
91+
expect_equal(res.length.b$`length of D$B in discordant2`, 0)
92+
expect_length(res.length.b$`length of D$B in discordant3`, 1)
93+
expect_equal(res.length.b$`length of D$B in discordant3`, 12)
94+
expect_length(res.length.b$`total length of D$B in all studies combined`, 1)
95+
expect_equal(res.length.b$`total length of D$B in all studies combined`, 24)
96+
97+
res.class.c <- ds.class(x='D$C')
98+
expect_length(res.class.c, 3)
99+
expect_length(res.class.c$discordant1, 1)
100+
expect_equal(res.class.c$discordant1, "NULL")
101+
expect_length(res.class.c$discordant2, 1)
102+
expect_equal(res.class.c$discordant2, "integer")
103+
expect_length(res.class.c$discordant3, 1)
104+
expect_equal(res.class.c$discordant3, "integer")
105+
106+
res.length.c <- ds.length(x='D$C')
107+
expect_length(res.length.c, 4)
108+
expect_length(res.length.c$`length of D$C in discordant1`, 1)
109+
expect_equal(res.length.c$`length of D$C in discordant1`, 0)
110+
expect_length(res.length.c$`length of D$C in discordant2`, 1)
111+
expect_equal(res.length.c$`length of D$C in discordant2`, 12)
112+
expect_length(res.length.c$`length of D$C in discordant3`, 1)
113+
expect_equal(res.length.c$`length of D$C in discordant3`, 12)
114+
expect_length(res.length.c$`total length of D$C in all studies combined`, 1)
115+
expect_equal(res.length.c$`total length of D$C in all studies combined`, 24)
116+
})
117+
118+
#
119+
# Tear down
120+
#
121+
122+
context("DISCORDANT::datachk::shutdown")
123+
124+
test_that("shutdown", {
125+
ds_expect_variables(c("D"))
126+
})
127+
128+
disconnect.discordant.dataset.simple()
129+
130+
#
131+
# Done
132+
#
133+
134+
context("DISCORDANT::datachk::done")

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

Lines changed: 0 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -597,36 +597,16 @@ test_that("simple glmPredict, poisson, with newobj, se.fit=TRUE", {
597597
expect_equal(res$sim1$safe.list$residual.scale, 1, tolerance = 1e-7)
598598
})
599599

600-
601-
#test_that("simple glmPredict, binomial, without newobj, se.fit=FALSE", {
602-
# glmSLMA.res <- ds.glmSLMA('D$DIS_DIAB~D$LAB_TSC', family="binomial", newobj="binomial.glmslma.obj")
603-
604-
# expect_length(glmSLMA.res, 9)
605-
# expect_equal(glmSLMA.res$num.valid.studies, 3)
606-
# expect_length(glmSLMA.res$validity.check, 1)
607-
# expect_equal(glmSLMA.res$validity.check, "<poisson.glmslma.obj> appears valid in all sources")
608-
#
609-
# res <- ds.glmPredict("binomial.glmslma.obj", newdataname = NULL, output.type = "response", se.fit = FALSE, na.action = "na.pass", newobj=NULL)
610-
611-
#print(res)
612-
#expect_length(res, 3)
613-
#expect_equal(class(res), "list")
614-
615-
#})
616-
617600
#
618601
# Shutdown
619602
#
620603

621604
context("ds.glmPredict::smk::shutdown")
622605

623606
test_that("shutdown", {
624-
print(ds.ls())
625607
ds_expect_variables(c("D", "gaussian.glm.predict.obj", "gaussian.glm.predict.sefit.obj", "gaussian.glmslma.obj", "poisson.glm.predict.obj", "poisson.glm.predict.sefit.obj", "poisson.glmslma.obj", "predict_glm" ))
626608
})
627609

628-
# ,"binomial.glmslma.obj"
629-
630610
disconnect.studies.dataset.cnsim()
631611

632612
#

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

Lines changed: 62 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -103,13 +103,69 @@ test_that("setup", {
103103

104104
context("ds.glmerSLMA::smk::test - phase 2")
105105

106-
test_that("check slope formulae", {
107-
# res = ds.glmerSLMA(formula = 'incid_rate ~ trtGrp + Male + (1|idDoctor) + (1|idSurgery) + (0+trtGrp|idSurgery)', family='poisson', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
108-
# expect_equal(res$Convergence.error.message[2], "Study2: no convergence error reported")
109-
# res = ds.glmerSLMA(formula = 'incid_rate ~ trtGrp + Male + (1|idDoctor) + (trtGrp||idSurgery)', family='poisson', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
110-
# expect_equal(res$Convergence.error.message[2], "Study2: no convergence error reported")
106+
test_that("check slope formulae - 1", {
107+
res = ds.glmerSLMA(formula = 'incid_rate ~ trtGrp + Male + (1|idDoctor) + (1|idSurgery) + (0+trtGrp|idSurgery)', family='poisson', dataName = 'D', control_type = 'check.conv.grad', control_value = 0.1)
108+
109+
expect_length(res, 8)
110+
expect_length(res$output.summary, 5)
111+
expect_equal(class(res$output.summary), "list")
112+
expect_length(res$num.valid.studies, 1)
113+
expect_equal(class(res$num.valid.studies), "numeric")
114+
expect_length(res$betamatrix.all, 9)
115+
expect_length(class(res$betamatrix.all), 2)
116+
expect_true("matrix" %in% class(res$betamatrix.all))
117+
expect_true("array" %in% class(res$betamatrix.all))
118+
expect_length(res$sematrix.all, 9)
119+
expect_length(class(res$sematrix.all), 2)
120+
expect_true("matrix" %in% class(res$sematrix.all))
121+
expect_true("array" %in% class(res$sematrix.all))
122+
expect_length(res$betamatrix.valid, 9)
123+
expect_length(class(res$betamatrix.valid), 2)
124+
expect_true("matrix" %in% class(res$betamatrix.valid))
125+
expect_true("array" %in% class(res$betamatrix.valid))
126+
expect_length(res$sematrix.valid, 9)
127+
expect_length(class(res$sematrix.valid), 2)
128+
expect_true("matrix" %in% class(res$sematrix.valid))
129+
expect_true("array" %in% class(res$sematrix.valid))
130+
expect_length(res$SLMA.pooled.ests.matrix, 18)
131+
expect_length(class(res$SLMA.pooled.ests.matrix), 2)
132+
expect_true("matrix" %in% class(res$SLMA.pooled.ests.matrix))
133+
expect_true("array" %in% class(res$SLMA.pooled.ests.matrix))
134+
expect_length(res$Convergence.error.message, 3)
135+
expect_equal(class(res$Convergence.error.message), "character")
111136
})
112137

138+
test_that("check slope formulae - 2", {
139+
res = ds.glmerSLMA(formula = 'incid_rate ~ trtGrp + Male + (1|idDoctor) + (trtGrp||idSurgery)', family='poisson', dataName = 'D', control_type = 'check.conv.grad', control_value = 0.1)
140+
141+
expect_length(res, 8)
142+
expect_length(res$output.summary, 5)
143+
expect_equal(class(res$output.summary), "list")
144+
expect_length(res$num.valid.studies, 1)
145+
expect_equal(class(res$num.valid.studies), "numeric")
146+
expect_length(res$betamatrix.all, 9)
147+
expect_length(class(res$betamatrix.all), 2)
148+
expect_true("matrix" %in% class(res$betamatrix.all))
149+
expect_true("array" %in% class(res$betamatrix.all))
150+
expect_length(res$sematrix.all, 9)
151+
expect_length(class(res$sematrix.all), 2)
152+
expect_true("matrix" %in% class(res$sematrix.all))
153+
expect_true("array" %in% class(res$sematrix.all))
154+
expect_length(res$betamatrix.valid, 9)
155+
expect_length(class(res$betamatrix.valid), 2)
156+
expect_true("matrix" %in% class(res$betamatrix.valid))
157+
expect_true("array" %in% class(res$betamatrix.valid))
158+
expect_length(res$sematrix.valid, 9)
159+
expect_length(class(res$sematrix.valid), 2)
160+
expect_true("matrix" %in% class(res$sematrix.valid))
161+
expect_true("array" %in% class(res$sematrix.valid))
162+
expect_length(res$SLMA.pooled.ests.matrix, 18)
163+
expect_length(class(res$SLMA.pooled.ests.matrix), 2)
164+
expect_true("matrix" %in% class(res$SLMA.pooled.ests.matrix))
165+
expect_true("array" %in% class(res$SLMA.pooled.ests.matrix))
166+
expect_length(res$Convergence.error.message, 3)
167+
expect_equal(class(res$Convergence.error.message), "character")
168+
})
113169

114170
#
115171
# Shutdown phase 2
@@ -118,7 +174,7 @@ test_that("check slope formulae", {
118174
context("ds.glmerSLMA::smk::shutdown - phase 2")
119175

120176
test_that("setup", {
121-
ds_expect_variables(c("D"))
177+
ds_expect_variables(c("D", "offset", "weights"))
122178
})
123179

124180
disconnect.studies.dataset.cluster.slo()

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

Lines changed: 62 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -104,11 +104,67 @@ test_that("setup", {
104104
context("ds.lmerSLMA::smk::test phase 2")
105105

106106
test_that("check slope formulae", {
107-
# res = ds.lmerSLMA(formula = 'BMI ~ trtGrp + Male + (1|idDoctor) + (1|idSurgery) + (0+trtGrp|idSurgery)', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
108-
# expect_equal(res$Convergence.error.message[2], "Study2: no convergence error reported", fixed=TRUE)
109-
# res = ds.lmerSLMA(formula = 'BMI ~ trtGrp + Male + (1|idDoctor) + (trtGrp||idSurgery)', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
110-
# expect_equal(res$Convergence.error.message[2], "Study2: no convergence error reported", fixed=TRUE)
111-
107+
res = ds.lmerSLMA(formula = 'BMI ~ trtGrp + Male + (1|idDoctor) + (1|idSurgery) + (0+trtGrp|idSurgery)', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
108+
109+
expect_length(res, 8)
110+
expect_length(res$output.summary, 5)
111+
expect_equal(class(res$output.summary), "list")
112+
expect_length(res$num.valid.studies, 1)
113+
expect_equal(class(res$num.valid.studies), "numeric")
114+
expect_length(res$betamatrix.all, 9)
115+
expect_length(class(res$betamatrix.all), 2)
116+
expect_true("matrix" %in% class(res$betamatrix.all))
117+
expect_true("array" %in% class(res$betamatrix.all))
118+
expect_length(res$sematrix.all, 9)
119+
expect_length(class(res$sematrix.all), 2)
120+
expect_true("matrix" %in% class(res$sematrix.all))
121+
expect_true("array" %in% class(res$sematrix.all))
122+
expect_length(res$betamatrix.valid, 9)
123+
expect_length(class(res$betamatrix.valid), 2)
124+
expect_true("matrix" %in% class(res$betamatrix.valid))
125+
expect_true("array" %in% class(res$betamatrix.valid))
126+
expect_length(res$sematrix.valid, 9)
127+
expect_length(class(res$sematrix.valid), 2)
128+
expect_true("matrix" %in% class(res$sematrix.valid))
129+
expect_true("array" %in% class(res$sematrix.valid))
130+
expect_length(res$SLMA.pooled.ests.matrix, 18)
131+
expect_length(class(res$SLMA.pooled.ests.matrix), 2)
132+
expect_true("matrix" %in% class(res$SLMA.pooled.ests.matrix))
133+
expect_true("array" %in% class(res$SLMA.pooled.ests.matrix))
134+
expect_length(res$Convergence.error.message, 3)
135+
expect_equal(class(res$Convergence.error.message), "character")
136+
})
137+
138+
test_that("check slope formulae", {
139+
res = ds.lmerSLMA(formula = 'BMI ~ trtGrp + Male + (1|idDoctor) + (trtGrp||idSurgery)', dataName = 'D', control_type = 'check.conv.grad',control_value = 0.1)
140+
141+
expect_length(res, 8)
142+
expect_length(res$output.summary, 5)
143+
expect_equal(class(res$output.summary), "list")
144+
expect_length(res$num.valid.studies, 1)
145+
expect_equal(class(res$num.valid.studies), "numeric")
146+
expect_length(res$betamatrix.all, 9)
147+
expect_length(class(res$betamatrix.all), 2)
148+
expect_true("matrix" %in% class(res$betamatrix.all))
149+
expect_true("array" %in% class(res$betamatrix.all))
150+
expect_length(res$sematrix.all, 9)
151+
expect_length(class(res$sematrix.all), 2)
152+
expect_true("matrix" %in% class(res$sematrix.all))
153+
expect_true("array" %in% class(res$sematrix.all))
154+
expect_length(res$betamatrix.valid, 9)
155+
expect_length(class(res$betamatrix.valid), 2)
156+
expect_true("matrix" %in% class(res$betamatrix.valid))
157+
expect_true("array" %in% class(res$betamatrix.valid))
158+
expect_length(res$sematrix.valid, 9)
159+
expect_length(class(res$sematrix.valid), 2)
160+
expect_true("matrix" %in% class(res$sematrix.valid))
161+
expect_true("array" %in% class(res$sematrix.valid))
162+
expect_length(res$SLMA.pooled.ests.matrix, 18)
163+
expect_length(class(res$SLMA.pooled.ests.matrix), 2)
164+
expect_true("matrix" %in% class(res$SLMA.pooled.ests.matrix))
165+
expect_true("array" %in% class(res$SLMA.pooled.ests.matrix))
166+
expect_length(res$Convergence.error.message, 3)
167+
expect_equal(class(res$Convergence.error.message), "character")
112168
})
113169

114170
#
@@ -118,9 +174,7 @@ test_that("check slope formulae", {
118174
context("ds.lmerSLMA::smk::shutdown phase 2")
119175

120176
test_that("shutdown", {
121-
#note the offset and weights objects below are artefacts
122-
123-
ds_expect_variables(c("D"))
177+
ds_expect_variables(c("D", "offset", "weights"))
124178
})
125179

126180
disconnect.studies.dataset.cluster.slo()

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

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -28,15 +28,15 @@ context("ds.meanByClass::smk::LAB_TSC across PM_BMI_CATEGORICAL categories where
2828
ds.assign("D$LAB_TSC", "ldl")
2929
ds.assign("D$PM_BMI_CATEGORICAL", "pm_bmi")
3030
test_that("LAB_TSC_across_", {
31-
# res <- ds.meanByClass(x='ldl~pm_bmi')
32-
#
33-
# expect_length(res, 6)
34-
# expect_equal(res[[1]], '2753')
35-
# expect_equal(res[[2]], '5.85(1.03)')
36-
# expect_equal(res[[3]], '3545')
37-
# expect_equal(res[[4]], '5.82(1.05)')
38-
# expect_equal(res[[5]], '2629')
39-
# expect_equal(res[[6]], '5.89(1.15)')
31+
res <- ds.meanByClass(x='ldl~pm_bmi')
32+
33+
expect_length(res, 6)
34+
expect_equal(res[[1]], '2753')
35+
expect_equal(res[[2]], '5.85(1.03)')
36+
expect_equal(res[[3]], '3545')
37+
expect_equal(res[[4]], '5.82(1.05)')
38+
expect_equal(res[[5]], '2629')
39+
expect_equal(res[[6]], '5.89(1.15)')
4040
})
4141

4242
context("ds.meanByClass::smk::calculate the mean proportion for LAB_HDL across PM_BMI_CATEGORICAL categories")
@@ -114,7 +114,7 @@ context("ds.meanByClass::smk::shutdown")
114114

115115
test_that("shutdown", {
116116
ds_expect_variables(c("D", "D.PM_BMI_CATEGORICAL1", "D.PM_BMI_CATEGORICAL2", "D.PM_BMI_CATEGORICAL3",
117-
"ldl", "pm_bmi", "tempholder"))
117+
"ldl", "pm_bmi", "tempholder", "X", "X.pm_bmi1", "X.pm_bmi2", "X.pm_bmi3"))
118118
})
119119

120120
disconnect.studies.dataset.cnsim()

0 commit comments

Comments
 (0)