Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
84 changes: 32 additions & 52 deletions R/classicalmetaanalysiscommon.R
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@
# - vs covariates
# Generic
# - allow different covariates factoring across all settings
# - confidence interval for heterogeneity in multilevel multivariate

ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

Expand Down Expand Up @@ -856,15 +855,17 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

# pooled estimates
pooledEstimatesTable <- createJaspTable(gettext("Meta-Analytic Estimates"))
pooledEstimatesTable$showSpecifiedColumnsOnly <- TRUE
pooledEstimatesTable$position <- 4
pooledEstimatesTable$dependOn(c("heterogeneityTau", "heterogeneityTau2", "heterogeneityI2", "heterogeneityH2",
"confidenceIntervals", "confidenceIntervalsLevel", "predictionIntervals", "transformEffectSize",
"includeFullDatasetInSubgroupAnalysis"))
"standardErrors", "includeFullDatasetInSubgroupAnalysis"))
modelSummaryContainer[["pooledEstimatesTable"]] <- pooledEstimatesTable

pooledEstimatesTable$addColumnInfo(name = "par", type = "string", title = "")
.maAddSubgroupColumn(pooledEstimatesTable, options)
pooledEstimatesTable$addColumnInfo(name = "est", type = "number", title = gettext("Estimate"))
.maAddSeColumn(pooledEstimatesTable, options)
.maAddCiColumn(pooledEstimatesTable, options)
.maAddPiColumn(pooledEstimatesTable, options)
if (options[["predictionIntervals"]] && .mammHasMultipleHeterogeneities(options, canAddOutput = TRUE)) {
Expand Down Expand Up @@ -1033,13 +1034,13 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
effectSize = 3,
heterogeneity = 4
)
coefficientsTable$dependOn(c("metaregressionCoefficientEstimates", "confidenceIntervals", "confidenceIntervalsLevel", "includeFullDatasetInSubgroupAnalysis"))
coefficientsTable$dependOn(c("metaregressionCoefficientEstimates", "confidenceIntervals", "confidenceIntervalsLevel", "standardErrors", "includeFullDatasetInSubgroupAnalysis"))
metaregressionContainer[[paste0(parameter, "CoefficientTable")]] <- coefficientsTable

coefficientsTable$addColumnInfo(name = "name", type = "string", title = "")
.maAddSubgroupColumn(coefficientsTable, options)
coefficientsTable$addColumnInfo(name = "est", type = "number", title = gettext("Estimate"))
coefficientsTable$addColumnInfo(name = "se", type = "number", title = gettext("Standard Error"))
.maAddSeColumn(coefficientsTable, options, noTransformation = TRUE)
.maAddCiColumn(coefficientsTable, options)
coefficientsTable$addColumnInfo(name = "stat", type = "number", title = if(.maIsMetaregressionFtest(options)) gettext("t") else gettext("z"))
if (.maIsMetaregressionFtest(options))
Expand Down Expand Up @@ -1327,10 +1328,11 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

estimatedMarginalMeansTable <- createJaspTable(if (selectedVariable == "") gettext("Adjusted Estimate") else gettext("Estimated Marginal Means"))
estimatedMarginalMeansTable$position <- 1
estimatedMarginalMeansTable$showSpecifiedColumnsOnly <- TRUE
estimatedMarginalMeansTable$dependOn(c(switch(
parameter,
effectSize = c("estimatedMarginalMeansEffectSize", "estimatedMarginalMeansEffectSizeSdFactorCovariates", "estimatedMarginalMeansEffectSizeTestAgainst",
"estimatedMarginalMeansEffectSizeTestAgainstValue", "transformEffectSize", "predictionIntervals"),
"estimatedMarginalMeansEffectSizeTestAgainstValue", "transformEffectSize", "predictionIntervals", "standardErrors"),
heterogeneity = c("estimatedMarginalMeansHeterogeneity", "estimatedMarginalMeansHeterogeneityTransformation", "estimatedMarginalMeansHeterogeneitySdFactorCovariates")
)))
variableContainer[["estimatedMarginalMeansTable"]] <- estimatedMarginalMeansTable
Expand All @@ -1340,6 +1342,8 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
estimatedMarginalMeansTable$addColumnInfo(name = "value", type = "string", title = gettext("Level"))
.maAddSubgroupColumn(estimatedMarginalMeansTable, options)
estimatedMarginalMeansTable$addColumnInfo(name = "est", type = "number", title = gettext("Estimate"))
if (parameter == "effectSize")
.maAddSeColumn(estimatedMarginalMeansTable, options)
.maAddCiColumn(estimatedMarginalMeansTable, options)
if (parameter == "effectSize") {
.maAddPiColumn(estimatedMarginalMeansTable, options)
Expand Down Expand Up @@ -1367,15 +1371,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
# reorder by estimated marginal means estimate
estimatedMarginalMeans <- .maSafeOrderAndSimplify(estimatedMarginalMeans, "value", options)

# drop non-required columns
estimatedMarginalMeans <- estimatedMarginalMeans[,!colnames(estimatedMarginalMeans) %in% "variable", drop = FALSE]
if (parameter == "effectSize" && !options[["estimatedMarginalMeansEffectSizeTestAgainst"]])
estimatedMarginalMeans <- estimatedMarginalMeans[,!colnames(estimatedMarginalMeans) %in% c("df", "stat", "pval"), drop = FALSE]
if (parameter == "heterogeneity")
estimatedMarginalMeans <- estimatedMarginalMeans[,!colnames(estimatedMarginalMeans) %in% c("lPi", "uPi"), drop = FALSE]
if (selectedVariable == "")
estimatedMarginalMeans <- estimatedMarginalMeans[,!colnames(estimatedMarginalMeans) %in% c("value"), drop = FALSE]

# set data
estimatedMarginalMeansTable$setData(estimatedMarginalMeans)

Expand All @@ -1390,9 +1385,10 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

contrastsTable <- createJaspTable(gettext("Contrasts"))
contrastsTable$position <- 1
contrastsTable$showSpecifiedColumnsOnly <- TRUE
contrastsTable$dependOn(switch(
parameter,
effectSize = c("contrastsEffectSize", "contrastsEffectSizePValueAdjustment", "predictionIntervals", "transformEffectSize"),
effectSize = c("contrastsEffectSize", "contrastsEffectSizePValueAdjustment", "predictionIntervals", "transformEffectSize", "standardErrors"),
heterogeneity = c("contrastsHeterogeneity", "contrastsHeterogeneityPValueAdjustment", "estimatedMarginalMeansHeterogeneityTransformation")
))
variableContainer[["contrastsTable"]] <- contrastsTable
Expand All @@ -1401,6 +1397,8 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
contrastsTable$addColumnInfo(name = "comparison", type = "string", title = gettext("Comparison"))
.maAddSubgroupColumn(contrastsTable, options)
contrastsTable$addColumnInfo(name = "est", type = "number", title = gettext("Estimate"))
if (parameter == "effectSize")
.maAddSeColumn(contrastsTable, options)
.maAddCiColumn(contrastsTable, options)
if (parameter == "effectSize") {
.maAddPiColumn(contrastsTable, options)
Expand All @@ -1427,10 +1425,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
# reorder by estimated marginal means estimate
contrasts <- .maSafeOrderAndSimplify(contrasts, "comparison", options)

# drop non-required columns
if (parameter == "heterogeneity")
contrasts <- contrasts[,!colnames(contrasts) %in% c("lPi", "uPi"), drop = FALSE]

# set data
contrastsTable$setData(contrasts)

Expand Down Expand Up @@ -2283,13 +2277,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
.maGetEffectSizeTransformationOptions(options[["transformEffectSize"]]),
list(predictedEffect[,c("est", "lCi", "uCi", "lPi", "uPi")]))

# remove non-requested columns
predictedEffect <- predictedEffect[,c(
"par", "est",
if (options[["confidenceIntervals"]]) c("lCi", "uCi"),
if (options[["predictionIntervals"]]) c("lPi", "uPi")
)]

# return the tau levels
if (.mammHasMultipleHeterogeneities(options, canAddOutput = TRUE) && options[["predictionIntervals"]])
predictedEffect <- cbind(predictedEffect, tauLevels)
Expand Down Expand Up @@ -2416,6 +2403,10 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
colnames(confIntHeterogeneity) <- c("est", "lCi", "uCi")
confIntHeterogeneity$par <- c("\U1D70F", "\U1D70F\U00B2", "I\U00B2", "H\U00B2")

if (options[["standardErrors"]]){
confIntHeterogeneity$se <- c(.maGetSqrtTransformationSeDeltaMethod(fit$tau2 ,fit$se.tau2), fit$se.tau2, NA, NA)
}

# keep only the requested parameters
heterogeneityShow <- c(
if (options[["heterogeneityTau"]]) 1,
Expand Down Expand Up @@ -2937,16 +2928,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
)
}


# remove unnecessary columns
computedMarginalMeans <- computedMarginalMeans[,!colnames(computedMarginalMeans) %in% "se", drop = FALSE]

if (!options[["confidenceIntervals"]])
computedMarginalMeans <- computedMarginalMeans[,!colnames(computedMarginalMeans) %in% c("lCi", "uCi"), drop = FALSE]

if (!options[["predictionIntervals"]])
computedMarginalMeans <- computedMarginalMeans[,!colnames(computedMarginalMeans) %in% c("lPi", "uPi"), drop = FALSE]

# return the tau levels
if (.mammHasMultipleHeterogeneities(options, canAddOutput = TRUE) && options[["predictionIntervals"]])
computedMarginalMeans <- cbind(computedMarginalMeans, tauLevels)
Expand Down Expand Up @@ -3106,15 +3087,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
# reformat
computedContrasts <- .maExtractAndFormatPrediction(computedContrasts)

# remove unnecessary columns
computedContrasts <- computedContrasts[,!colnames(computedContrasts) %in% "se", drop = FALSE]

if (!options[["confidenceIntervals"]])
computedContrasts <- computedContrasts[,!colnames(computedContrasts) %in% c("lCi", "uCi"), drop = FALSE]

if (!options[["predictionIntervals"]])
computedContrasts <- computedContrasts[,!colnames(computedContrasts) %in% c("lPi", "uPi"), drop = FALSE]

# TODO: ? return the tau levels
# if (.mammHasMultipleHeterogeneities(options, canAddOutput = TRUE) && options[["predictionIntervals"]])
# computedMarginalMeans <- cbind(computedMarginalMeans, tauLevels)
Expand Down Expand Up @@ -4047,6 +4019,7 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
"estimatedMarginalMeansEffectSizeSdFactorCovariates",
"estimatedMarginalMeansEffectSizeAddAdjustedEstimate",

"standardErrors",
"confidenceIntervals",
"confidenceIntervalsLevel",
"predictionIntervals",
Expand Down Expand Up @@ -4466,12 +4439,6 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {
}
row$subgroup <- attr(fit, "subgroup")

row <- row[,c(
"par", "est",
if (options[["confidenceIntervals"]]) c("lCi", "uCi"),
"subgroup"
)]

return(row)
}
.maRowFitMeasures <- function(fit, options) {
Expand Down Expand Up @@ -4715,6 +4682,17 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

return(tempTable)
}
.maAddSeColumn <- function(tempTable, options, noTransformation = FALSE) {

if (!options[["standardErrors"]])
return(tempTable)

if (noTransformation || options[["transformEffectSize"]] == "none") {
tempTable$addColumnInfo(name = "se", title = gettext("Standard Error"), type = "number")
}

return(tempTable)
}
.maAddSubgroupColumn <- function(tempTable, options) {

if (options[["subgroup"]] != "")
Expand Down Expand Up @@ -5014,7 +4992,9 @@ ClassicalMetaAnalysisCommon <- function(jaspResults, dataset, options, ...) {

return(termsIndicies)
}

.maGetSqrtTransformationSeDeltaMethod <- function(estimate, estimate_se) {
estimate_se / (2 * sqrt(estimate))
}
# messages
.maFixedEffectTextMessage <- function(options) {
return(switch(
Expand Down
11 changes: 11 additions & 0 deletions inst/qml/qml_components/ClassicalMetaAnalysisStatistics.qml
Original file line number Diff line number Diff line change
Expand Up @@ -127,6 +127,16 @@ Section

Group
{

CheckBox
{
text: qsTr("Standard errors")
name: "standardErrors"
checked: true
enabled: transformEffectSizeDropdown.value === "none"
info: qsTr("Include standard errors in the tabular output. Only available when no effect size transformation is applied.")
}

CheckBox
{
name: "confidenceIntervals"
Expand All @@ -152,6 +162,7 @@ Section

DropDown
{//TODO: make shorter or across both rows?
id: transformEffectSizeDropdown
name: "transformEffectSize"
label: qsTr("Transform effect size")
setLabelAbove: true
Expand Down
Loading