Skip to content

Commit 27881f4

Browse files
StuartWheaterStuartWheater
authored
Merge pull request #281 from StuartWheater/v6.1-dev
Additional tests
2 parents 2598d7d + 4cf00c8 commit 27881f4

7 files changed

Lines changed: 210 additions & 77 deletions

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

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

Lines changed: 36 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -46,7 +46,9 @@ test_that("exists - request message", {
4646
expect_equal(message.res$sim3, "ALL OK: there are no studysideMessage(s) on this datasource", fixed=TRUE)
4747
})
4848

49-
test_that("partial - request message", {
49+
test_that("partial - request message - conn 1", {
50+
ds.rm("TestP")
51+
5052
ds.list("D$LAB_TSC", newobj="TestP", datasources=ds.test_env$connections[1])
5153

5254
message.res <- ds.message('TestP')
@@ -55,6 +57,38 @@ test_that("partial - request message", {
5557
expect_equal(message.res$sim1, "ALL OK: there are no studysideMessage(s) on this datasource", fixed=TRUE)
5658
expect_equal(message.res$sim2, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
5759
expect_equal(message.res$sim3, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
60+
61+
ds.rm("TestP")
62+
})
63+
64+
test_that("partial - request message - conn 2", {
65+
ds.rm("TestP")
66+
67+
ds.list("D$LAB_TSC", newobj="TestP", datasources=ds.test_env$connections[2])
68+
69+
message.res <- ds.message('TestP')
70+
71+
expect_length(message.res, 3)
72+
expect_equal(message.res$sim1, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
73+
expect_equal(message.res$sim2, "ALL OK: there are no studysideMessage(s) on this datasource", fixed=TRUE)
74+
expect_equal(message.res$sim3, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
75+
76+
ds.rm("TestP")
77+
})
78+
79+
test_that("partial - request message - conn 3", {
80+
ds.rm("TestP")
81+
82+
ds.list("D$LAB_TSC", newobj="TestP", datasources=ds.test_env$connections[3])
83+
84+
message.res <- ds.message('TestP')
85+
86+
expect_length(message.res, 3)
87+
expect_equal(message.res$sim1, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
88+
expect_equal(message.res$sim2, "Error: the object <message.object.name> does not exist in this datasource", fixed=TRUE)
89+
expect_equal(message.res$sim3, "ALL OK: there are no studysideMessage(s) on this datasource", fixed=TRUE)
90+
91+
ds.rm("TestP")
5892
})
5993

6094
#
@@ -63,7 +97,7 @@ test_that("partial - request message", {
6397
context("ds.message::smk::shutdown")
6498

6599
test_that("shutdown", {
66-
# ds_expect_variables(c("D", "TestP"))
100+
ds_expect_variables(c("D", "Test"))
67101
})
68102

69103
disconnect.studies.dataset.cnsim()

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

Lines changed: 28 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -77,18 +77,17 @@ test_that("simple table 2D", {
7777

7878
context("ds.table::smk")
7979
test_that("simple table 3D", {
80-
# table1.res <- ds.table(rvar='tablesource_subset$factorInteger', cvar='tablesource_subset$factorCharacter', stvar='tablesource_subset$factorCategory')
81-
82-
# expect_length(table1.res, 2)
83-
# expect_length(table1.res$output.list, 6)
84-
# expect_equal(class(table1.res$output.list[1]), "list")
85-
# expect_equal(class(table1.res$output.list[2]), "list")
86-
# expect_equal(class(table1.res$output.list[3]), "list")
87-
# expect_equal(class(table1.res$output.list[4]), "list")
88-
# expect_equal(class(table1.res$output.list[5]), "list")
89-
# expect_equal(class(table1.res$output.list[6]), "list")
90-
# expect_length(table1.res$validity.message, 1)
91-
# expect_equal(table1.res$validity.message, "Data in all studies were valid")
80+
table1.res <- ds.table(rvar='tablesource_subset$factorInteger', cvar='tablesource_subset$factorCharacter', stvar='tablesource_subset$factorCategory')
81+
82+
expect_length(table1.res, 2)
83+
expect_length(table1.res$output.list, 6)
84+
expect_equal(class(table1.res$output.list[1]), "list")
85+
expect_equal(class(table1.res$output.list[2]), "list")
86+
expect_equal(class(table1.res$output.list[3]), "list")
87+
expect_equal(class(table1.res$output.list[4]), "list")
88+
expect_equal(class(table1.res$output.list[5]), "list")
89+
expect_equal(class(table1.res$output.list[6]), "list")
90+
expect_length(table1.res$validity.message, 4)
9291
})
9392

9493
test_that("simple table 1D, with assign", {
@@ -130,22 +129,22 @@ test_that("simple table 2D, with assign", {
130129
})
131130

132131
test_that("simple table 3D, with assign", {
133-
# table.res <- ds.table(rvar='tablesource_subset$factorInteger', cvar='tablesource_subset$factorCharacter', stvar='tablesource_subset$factorCategory', newobj="new_table3", table.assign=TRUE)
134-
135-
# expect_length(table.res, 0)
136-
137-
# table.length <- ds.length("new_table3")
138-
# expect_length(table.length, 4)
139-
# expect_equal(table.length$`length of new_table2 in study1`, 4)
140-
# expect_equal(table.length$`length of new_table2 in study2`, 4)
141-
# expect_equal(table.length$`length of new_table2 in study3`, 4)
142-
# expect_equal(table.length$`total length of new_table2 in all studies combined`, 12)
143-
144-
# table.class <- ds.class("new_table3")
145-
# expect_length(table.class, 3)
146-
# expect_equal(table.class$study1, 'list')
147-
# expect_equal(table.class$study2, 'list')
148-
# expect_equal(table.class$study3, 'list')
132+
table.res <- ds.table(rvar='tablesource_subset$factorInteger', cvar='tablesource_subset$factorCharacter', stvar='tablesource_subset$factorCategory', newobj="new_table3", table.assign=TRUE)
133+
134+
expect_length(table.res, 0)
135+
136+
table.length <- ds.length("new_table3")
137+
expect_length(table.length, 4)
138+
expect_equal(table.length$`length of new_table3 in study1`, 4)
139+
expect_equal(table.length$`length of new_table3 in study2`, 4)
140+
expect_equal(table.length$`length of new_table3 in study3`, 4)
141+
expect_equal(table.length$`total length of new_table3 in all studies combined`, 12)
142+
143+
table.class <- ds.class("new_table3")
144+
expect_length(table.class, 3)
145+
expect_equal(table.class$study1, 'list')
146+
expect_equal(table.class$study2, 'list')
147+
expect_equal(table.class$study3, 'list')
149148
})
150149

151150
#
@@ -155,7 +154,7 @@ test_that("simple table 3D, with assign", {
155154
context("ds.table::smk::shutdown")
156155

157156
test_that("shutdown", {
158-
ds_expect_variables(c("D", "factorCharacter", "factorInteger", "factorCategory", "tablesource", "tablesource_subset", "new_table1", "new_table2"))
157+
ds_expect_variables(c("D", "factorCharacter", "factorInteger", "factorCategory", "tablesource", "tablesource_subset", "new_table1", "new_table2", "new_table3"))
159158
})
160159

161160
disconnect.all.datasets()

0 commit comments

Comments
 (0)