Skip to content

Commit

Permalink
fix ClassicalMetaAnalysis unit tests
Browse files Browse the repository at this point in the history 
- rank test not applicable to meta-regression anymore
- fixing change of argument names in fail safe n
  • Loading branch information
@FBartos
FBartos committed Oct 5, 2023
1 parent 9113031 commit c80e291
Show file tree
Hide file tree
Showing 2 changed files with 27 additions and 39 deletions.
2 changes: 1 addition & 1 deletion R/classicalmetaanalysiscommon.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -519,7 +519,7 @@
.metaAnalysisFailSafeFill <- function(container, dataset, options) {
# Compute/get model
rma.fit <- .metaAnalysisComputeModel(container, dataset, options, ready)
fsn.fit <- metafor::fsn(yi = get(options$effectSize),
fsn.fit <- metafor::fsn(x = get(options$effectSize),
sei = get(options$effectSizeSe),
data = dataset)
container[["failSafeTable"]]$addRows(list("name" = fsn.fit$type,
Expand Down
64 changes: 26 additions & 38 deletions tests/testthat/test-classicalmetaanalysis.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,13 +8,13 @@ options$forestPlot <- TRUE
options$funnelPlot <- TRUE
options$funnelPlotRegressionTestAsymmetry <- TRUE
options$method <- "Restricted ML"
options$modelTerms <- list(list(components = "contcor2"),
list(components = "facGender"),
options$modelTerms <- list(list(components = "contcor2"),
list(components = "facGender"),
list(components = "facExperim"))
options$failSafeN <- TRUE
options$diagnosticPlot <- TRUE
options$profilePlot <- TRUE
options$funnelPlotRankTestAsymmetry <- TRUE
options$funnelPlotRankTestAsymmetry <- FALSE
options$coefficientCi <- TRUE
options$covarianceMatrix <- TRUE
options$casewiseDiagnostics <- TRUE
Expand Down Expand Up @@ -331,12 +331,6 @@ test_that("Trim-fill Analysis plot matches", {
expect_equal_plots(testPlot, "trim-fill-analysis")
})

test_that("Rank correlation test for Funnel plot asymmetry table results match", {
table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rankTestTable"]][["data"]]
expect_equal_tables(table,
list(0.00686868686868687, "Rank test", 0.921921630071705))
})

test_that("Regression test for Funnel plot asymmetry (\"Egger's test\") table results match", {
table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_regTestTable"]][["data"]]
expect_equal_tables(table,
Expand All @@ -355,32 +349,32 @@ test_that("Residual Heterogeneity Estimates table results match", {

test_that("Analysis handles errors", {
options <- jaspTools::analysisOptions("ClassicalMetaAnalysis")

options$effectSize <- "debInf"
options$effectSizeSe <- "contGamma"
results <- jaspTools::runAnalysis("ClassicalMetaAnalysis", "test.csv", options)
expect_identical(results[["status"]], "validationError", label="Inf dependent check")

options$effectSize <- "contNormal"
options$effectSizeSe <- "debInf"
results <- jaspTools::runAnalysis("ClassicalMetaAnalysis", "test.csv", options)
expect_identical(results[["status"]], "validationError", label="Inf covariate check")

options$effectSize <- "debSame"
options$effectSizeSe <- "contGamma"
results <- jaspTools::runAnalysis("ClassicalMetaAnalysis", "test.csv", options)
expect_identical(results[["status"]], "validationError", label="No variance dependent check")

options$effectSize <- "contNormal"
options$effectSizeSe <- "debSame"
results <- jaspTools::runAnalysis("ClassicalMetaAnalysis", "test.csv", options)
expect_identical(results[["status"]], "validationError", label="No variance covariate check")

options$effectSize <- "contGamma"
options$effectSizeSe <- "contcor1"
results <- jaspTools::runAnalysis("ClassicalMetaAnalysis", "test.csv", options)
expect_identical(results[["status"]], "validationError", label = "Negative effectSizeSe check")

})

#model interaction tests
Expand All @@ -392,25 +386,25 @@ options$forestPlot <- TRUE
options$funnelPlot <- TRUE
options$funnelPlotRegressionTestAsymmetry <- TRUE
options$method <- "Restricted ML"
options$modelTerms <- list(list(components = "contcor1"),
list(components = "contcor2"),
list(components = "facGender"),
list(components = "facExperim"),
list(components = c("contcor1", "contcor2")),
list(components = c("contcor1", "facGender")),
list(components = c("contcor1", "facExperim")),
list(components = c("contcor2", "facGender")),
list(components = c("contcor2", "facExperim")),
list(components = c("facGender", "facExperim")),
list(components = c("contcor1", "contcor2", "facGender")),
list(components = c("contcor1", "contcor2", "facExperim")),
list(components = c("contcor1", "facGender", "facExperim")),
list(components = c("contcor2", "facGender", "facExperim")),
options$modelTerms <- list(list(components = "contcor1"),
list(components = "contcor2"),
list(components = "facGender"),
list(components = "facExperim"),
list(components = c("contcor1", "contcor2")),
list(components = c("contcor1", "facGender")),
list(components = c("contcor1", "facExperim")),
list(components = c("contcor2", "facGender")),
list(components = c("contcor2", "facExperim")),
list(components = c("facGender", "facExperim")),
list(components = c("contcor1", "contcor2", "facGender")),
list(components = c("contcor1", "contcor2", "facExperim")),
list(components = c("contcor1", "facGender", "facExperim")),
list(components = c("contcor2", "facGender", "facExperim")),
list(components = c("contcor1", "contcor2", "facGender", "facExperim")))
options$failSafeN <- TRUE
options$diagnosticPlot <- TRUE
options$profilePlot <- TRUE
options$funnelPlotRankTestAsymmetry <- TRUE
options$funnelPlotRankTestAsymmetry <- FALSE
options$coefficientCi <- TRUE
options$covarianceMatrix <- TRUE
options$casewiseDiagnostics <- TRUE
Expand Down Expand Up @@ -833,12 +827,6 @@ test_that("Trim-fill Analysis plot matches - model interactions", {
expect_equal_plots(testPlot, "trim-fill-analysis-model")
})

test_that("Rank correlation test for Funnel plot asymmetry table results match - model interactions", {
table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rankTestTable"]][["data"]]
expect_equal_tables(table,
list(0.0703030303030303, "Rank test", 0.302256516349067))
})

test_that("Regression test for Funnel plot asymmetry (\"Egger's test\") table results match - model interactions", {
table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_regTestTable"]][["data"]]
expect_equal_tables(table,
Expand All @@ -859,7 +847,7 @@ test_that("Residual Heterogeneity Estimates table results match - model interact
# test the diagnostic plot without the Q-Q plot
options <- jaspTools::analysisOptions("ClassicalMetaAnalysis")
options$.meta <- list(covariates = list(containsColumn = TRUE), effectSize = list(
containsColumn = TRUE), factors = list(containsColumn = TRUE),
containsColumn = TRUE), factors = list(containsColumn = TRUE),
studyLabel = list(containsColumn = TRUE), effectSizeSe = list(
containsColumn = TRUE))
options$effectSize <- "ES"
Expand Down Expand Up @@ -890,4 +878,4 @@ test_that("Diagnostic Plots matches without Q-Q plot", {
plotName <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_plots"]][["collection"]][["modelContainer_plots_diagnosticPlot"]][["data"]]
testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
expect_equal_plots(testPlot, "diagnostic-plots-no-qq")
})
})

0 comments on commit c80e291

Please sign in to comment.