Release and Data Library Fixes (#257)

DESCRIPTION

@@ -33,10 +33,12 @@ Imports:
   CompQuadForm,
   sp,
   dfoptim,
+  nleqslv,
   patchwork
 Remotes:
   jasp-stats/jaspBase,
   jasp-stats/jaspGraphs
 Depends: 
     R (>= 2.10)
 LazyData: true
+RoxygenNote: 7.3.2

R/classicalmetaanalysiscommon.R

@@ -54,6 +54,7 @@
 
   # model summary
   .maResidualHeterogeneityTable(jaspResults, dataset, options)
+  .maPooledEffectSizeTestTable(jaspResults, dataset, options)
   .maModeratorsTable(jaspResults, dataset, options)
   .maPooledEstimatesTable(jaspResults, dataset, options)
 
@@ -364,6 +365,48 @@
 
   return()
 }
+.maPooledEffectSizeTestTable          <- function(jaspResults, dataset, options) {
+
+  modelSummaryContainer <- .maExtractModelSummaryContainer(jaspResults)
+
+  if (!is.null(modelSummaryContainer[["pooledEffectSizeTest"]]))
+    return()
+
+  fit <- .maExtractFit(jaspResults, options)
+
+  pooledEffectSizeTest <- createJaspTable(gettext("Pooled Effect Size Test"))
+  pooledEffectSizeTest$position <- 1.1
+  pooledEffectSizeTest$dependOn("confidenceIntervals")
+  modelSummaryContainer[["pooledEffectSizeTest"]] <- pooledEffectSizeTest
+
+  pooledEffectSizeTest$addColumnInfo(name = "est",   type = "number", title = gettext("Estimate"))
+  pooledEffectSizeTest$addColumnInfo(name = "se",    type = "number", title = gettext("Standard Error"))
+  pooledEffectSizeTest$addColumnInfo(name = "stat",  type = "number", title = if(.maIsMetaregressionFtest(options)) gettext("t") else gettext("z"))
+  if (.maIsMetaregressionFtest(options))
+    pooledEffectSizeTest$addColumnInfo(name = "df",  type = "number", title = gettext("df"))
+  pooledEffectSizeTest$addColumnInfo(name = "pval",  type = "pvalue", title = gettext("p"))
+
+  if (is.null(fit) || jaspBase::isTryError(fit))
+    return()
+
+  # do not perform transformation on the estimate (keep est and se on the same scale)
+  options[["transformEffectSize"]] <- "none"
+  predictedEffect <- .maComputePooledEffectPlot(fit, options)
+
+  estimates <- data.frame(
+    est  = predictedEffect[["est"]],
+    se   = predictedEffect[["se"]],
+    stat = predictedEffect[["stat"]],
+    pval = predictedEffect[["pval"]]
+  )
+
+  if (.maIsMetaregressionFtest(options))
+    estimates$df <- predictedEffect[["df"]]
+
+  pooledEffectSizeTest$setData(estimates)
+
+  return()
+}
 .maModeratorsTable                    <- function(jaspResults, dataset, options) {
 
   modelSummaryContainer <- .maExtractModelSummaryContainer(jaspResults)
@@ -1576,7 +1619,7 @@
   if (.mammHasMultipleHeterogeneities(options, canAddOutput = TRUE) && options[["predictionIntervals"]])
     predictedEffect <- cbind(predictedEffect, tauLevels)
 
-  return(predictedEffect <- apply(predictedEffect, 1, as.list))
+  return(apply(predictedEffect, 1, as.list))
 }
 .maComputePooledEffectPlot         <- function(fit, options) {
 
@@ -2489,7 +2532,12 @@
     rmaInput <- c(rmaInput, .maExtendMetaforCallFromOptions(options))
 
   ### fit the model
-  fit <- paste0("fit <- rma(\n\t", paste(names(rmaInput), "=", rmaInput, collapse = ",\n\t"), "\n)\n")
+  if (.maIsMultilevelMultivariate(options)) {
+    fit <- paste0("fit <- rma.mv(\n\t", paste(names(rmaInput), "=", rmaInput, collapse = ",\n\t"), "\n)\n")
+  } else {
+    fit <- paste0("fit <- rma(\n\t", paste(names(rmaInput), "=", rmaInput, collapse = ",\n\t"), "\n)\n")
+  }
+
 
   # add clustering if specified
   if (options[["clustering"]] != "") {
@@ -2819,14 +2867,22 @@
 .maGetControlOptions                  <- function(options) {
 
   if (.maIsMetaregressionHeterogeneity(options)) {
-    out <- list(
-      optimizer = options[["optimizerMethod"]],
-      iter.max  = if (options[["optimizerMaximumIterations"]]) options[["optimizerMaximumIterationsValue"]],
-      rel.tol   = if (options[["optimizerConvergenceRelativeTolerance"]]) options[["optimizerConvergenceRelativeToleranceValue"]]
-    )
+    if (options[["optimizerMethod"]] == "nlminb" && !options[["optimizerMaximumIterations"]] && !options[["optimizerConvergenceRelativeTolerance"]]) {
+      # allow an empty list for default settings --- this allows manual modification of the control argument through extra input
+      out <- list()
+    } else {
+      out <- list(
+        optimizer = options[["optimizerMethod"]],
+        iter.max  = if (options[["optimizerMaximumIterations"]]) options[["optimizerMaximumIterationsValue"]],
+        rel.tol   = if (options[["optimizerConvergenceRelativeTolerance"]]) options[["optimizerConvergenceRelativeToleranceValue"]]
+      )
+    }
   } else {
     if (.maIsMultilevelMultivariate(options)) {
-      if (options[["optimizerMethod"]] == "nlminb") {
+      if (options[["optimizerMethod"]] == "nlminb" && !options[["optimizerMaximumEvaluations"]] && !options[["optimizerMaximumIterations"]] && !options[["optimizerConvergenceRelativeTolerance"]]) {
+        # allow an empty list for default settings --- this allows manual modification of the control argument through extra input
+        out <- list()
+      } else if (options[["optimizerMethod"]] == "nlminb") {
         out <- list(
           optimizer = options[["optimizerMethod"]],
           eval.max  = if (options[["optimizerMaximumEvaluations"]]) options[["optimizerMaximumEvaluationsValue"]],

R/classicalmetaanalysismultilevelmultivariate.R

@@ -181,7 +181,12 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
         if (distanceMatrixFileName != "" && tempValueInner != "") {
 
           # try regular csv loading
-          distanceMatrix <- try(as.matrix(read.csv(file = distanceMatrixFileName, row.names = 1)))
+          if (tolower(gsub(" ", "", distanceMatrixFileName)) == "examplemaire2019distancematrix") {
+            # allow to load example data for data library
+            distanceMatrix <- .mammGetExampleMaire2019DistanceMatrix()
+          }else{
+            distanceMatrix <- try(as.matrix(read.csv(file = distanceMatrixFileName, row.names = 1)))
+          }
 
           if (inherits(distanceMatrix, "try-error"))
             .quitAnalysis(gettextf("Error reading the distance matrix file: %1$s", distanceMatrix))
@@ -340,13 +345,14 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
 }
 .mammRandomEstimatesTable        <- function(jaspResults, dataset, options) {
 
-  if (!is.null(jaspResults[["randomEstimatesContainer"]]))
-    return()
-
-  randomEstimatesContainer <- createJaspContainer(title = gettext("Random Effects / Model Stucture Summary"))
-  randomEstimatesContainer$dependOn(.maDependencies)
-  randomEstimatesContainer$position <- 2
-  jaspResults[["randomEstimatesContainer"]] <- randomEstimatesContainer
+  if (!is.null(jaspResults[["randomEstimatesContainer"]])) {
+    randomEstimatesContainer <- jaspResults[["randomEstimatesContainer"]]
+  } else {
+    randomEstimatesContainer <- createJaspContainer(title = gettext("Random Effects / Model Stucture Summary"))
+    randomEstimatesContainer$dependOn(.maDependencies)
+    randomEstimatesContainer$position <- 2
+    jaspResults[["randomEstimatesContainer"]] <- randomEstimatesContainer
+  }
 
   fit <- .maExtractFit(jaspResults, options)
 
@@ -355,7 +361,7 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
     return()
 
   ### create table for nested random effects
-  if (fit[["withS"]]) {
+  if (fit[["withS"]] && is.null(randomEstimatesContainer[["containerS"]])) {
 
     containerS <- createJaspContainer(title = gettext("Simple / Nested Summary"))
     containerS$position <- 1
@@ -390,7 +396,7 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
   }
 
   ### create summary for the remaining types
-  if (fit[["withG"]]) {
+  if (fit[["withG"]] && is.null(randomEstimatesContainer[["containerG"]])) {
 
     # create jasp containers
     containerG <- createJaspContainer(title = .mammGetRandomEstimatesTitle(fit[["struct"]][1]))
@@ -400,7 +406,7 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
 
   }
 
-  if (fit[["withH"]]) {
+  if (fit[["withH"]] && is.null(randomEstimatesContainer[["containerH"]])) {
 
     containerH <- createJaspContainer(title = .mammGetRandomEstimatesTitle(fit[["struct"]][2]))
     containerH$position <- 3
@@ -410,7 +416,7 @@ ClassicalMetaAnalysisMultilevelMultivariate <- function(jaspResults, dataset = N
   }
 
   ### create random structure inclusion summary
-  if (options[["randomEffectsTestInclusion"]]) {
+  if (options[["randomEffectsTestInclusion"]] && is.null(randomEstimatesContainer[["tableInclusion"]])) {
 
     tableInclusion <- createJaspTable(title = gettext("Inclusion Test"))
     tableInclusion$position <- 4

R/data.R

@@ -5,7 +5,24 @@
 #' (vignette at https://cran.r-project.org/web/packages/RoBMA/vignettes/Tutorial.html)
 #'
 #'
-#' @format An RDS file
+#' @format An RData file
 #'
 #' @return An object of class RoBMA.
 "exampleRobmaLui2015"
+
+
+#' @title Maire 2019 distance matrix
+#'
+#' @description Distance matrix from Maire et al. (2019) for the example
+#' multilevel/multivariate meta-analysis. See dat.maire2019 in the metadat
+#' package.
+#'
+#' @format An Rdata file
+#'
+#' @return A distance matrix
+"exampleMaire2019DistanceMatrix"
+
+.mammGetExampleMaire2019DistanceMatrix <- function() {
+  data("exampleMaire2019DistanceMatrix")
+  return(exampleMaire2019DistanceMatrix)
+}

inst/qml/ClassicalMetaAnalysisMultilevelMultivariate.qml

@@ -82,6 +82,7 @@ Form
 			id:					predictors
 			title:				qsTr("Predictors")
 			allowedColumns:		["nominal", "scale"]
+			allowTypeChange:	true
 			info: qsTr("Variables to include as predictors (moderators) in the meta-regression model.")
 		}