From c80e291fe6c79baefde450cd086583a8083c4dd2 Mon Sep 17 00:00:00 2001 From: FBartos Date: Thu, 5 Oct 2023 10:13:32 +0200 Subject: [PATCH] fix ClassicalMetaAnalysis unit tests - rank test not applicable to meta-regression anymore - fixing change of argument names in fail safe n --- R/classicalmetaanalysiscommon.R | 2 +- tests/testthat/test-classicalmetaanalysis.R | 64 +++++++++------------ 2 files changed, 27 insertions(+), 39 deletions(-) diff --git a/R/classicalmetaanalysiscommon.R b/R/classicalmetaanalysiscommon.R index 246d664b..fb553835 100644 --- a/R/classicalmetaanalysiscommon.R +++ b/R/classicalmetaanalysiscommon.R @@ -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, diff --git a/tests/testthat/test-classicalmetaanalysis.R b/tests/testthat/test-classicalmetaanalysis.R index 5fb8f453..acdfdc81 100644 --- a/tests/testthat/test-classicalmetaanalysis.R +++ b/tests/testthat/test-classicalmetaanalysis.R @@ -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 @@ -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, @@ -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 @@ -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 @@ -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, @@ -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" @@ -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") -}) \ No newline at end of file +})