Skip to content

Commit

Permalink
Fix error message for invalid local test type
Browse files Browse the repository at this point in the history
  • Loading branch information
@maltelueken
maltelueken committed Nov 8, 2023
1 parent 2162d9e commit e4434cf
Show file tree
Hide file tree
Showing 2 changed files with 98 additions and 8 deletions.
26 changes: 18 additions & 8 deletions R/classicProcess.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -427,8 +427,10 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {

.procReadData <- function(options) {
# Read in selected variables from dataset
vars <- c(options[['dependent']], options[['covariates']], options[['factors']])
dataset <- .readDataSetToEnd(columns = vars)
dataset <- .readDataSetToEnd(
columns = c(options[['dependent']], options[['covariates']]),
columns.as.factor = options[['factors']]
)

# Standardize variables to get standardized estimates
if (options$standardizedEstimates != "unstandardized") {
Expand Down Expand Up @@ -1727,14 +1729,20 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
}

# Sets container error if invalid
.procIsValidModel(modelContainer, procResults[[i]])
isValid <- .procIsValidModel(modelContainer, procResults[[i]])

if (isValid && !procResults[[i]]@Options[["do.fit"]]) {
next
}

contrasts <- modelsContainer[[modelNames[i]]][["contrasts"]]$object

if (options[["processModels"]][[i]][["localTests"]])
.procLocalTestTable(modelContainer, dataset, options, procResults[[i]], i)
.procLocalTestTable(modelContainer, dataset, options, procResults[[i]], contrasts, i)
}
}

.procLocalTestTable <- function(container, dataset, options, procResults, modelIdx) {
.procLocalTestTable <- function(container, dataset, options, procResults, contrasts, modelIdx) {
if (!is.null(container[["localTestTable"]])) return()

localTestTable <- createJaspTable(title = gettext("Conditional independence tests"))
Expand All @@ -1751,6 +1759,9 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {

if (container$getError()) return()

# Only test variables in dataset that are part of model
dataset <- dataset[encodeColNames(procResults@Data@ov$name)]

if (!procResults@Fit@converged) {
localTestTable$addFootnote(gettext("Model did not converge."))
}
Expand Down Expand Up @@ -1805,7 +1816,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
localTestTable$addColumnInfo(name = "ci.upper", title = gettext("Upper"), type = "number", format = "sf:4;dp:3",
overtitle = gettextf("%s%% Confidence Interval", options$ciLevel * 100))

if (testType == "cis" && any(sapply(dataset, is.factor))) {
if (testType == "cis" && !is.null(contrasts) && length(contrasts) > 0) {
localTestTable$setError(gettext("Linear test type cannot be applied to factor variables. Choose a different test type or remove all factor variables from the model."))
return()
}
Expand All @@ -1823,7 +1834,7 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
})

parNamesAbbr <- abbreviate(unique(unlist(parTable[c("lhs", "rhs")])))

graph <- dagitty::dagitty(paste("dag {", paste(arrows, collapse = "\n")," } "))

localTestResult <- dagitty::localTests(
Expand Down Expand Up @@ -1853,7 +1864,6 @@ ClassicProcess <- function(jaspResults, dataset = NULL, options) {
}
} else {
localTestTable$setError(gettext("The specified model does not imply any (conditional) independencies that can be tested."))

}
}

Expand Down
80 changes: 80 additions & 0 deletions tests/testthat/test-classic-process-integration-general.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -888,3 +888,83 @@ test_that("Not implemented Hayes models error message work", {
testPlot <- results[["state"]][["figures"]][[plotName]][["obj"]]
jaspTools::expect_equal_plots(testPlot, "statistical-path-plot-error-hayes")
})

test_that("Invalid test type error message work", {
options <- jaspTools::analysisOptions("ClassicProcess")
options$dependent <- "contNormal"
options$covariates <- list("contGamma", "debCollin1", "contcor1", "contNormal")
options$factors <- list("facGender")
options$statisticalPathPlotsCovariances <- TRUE
options$statisticalPathPlotsResidualVariances <- TRUE
options$errorCalculationMethod <- "standard"
options$ciLevel <- 0.95
options$naAction <- "fiml"
options$emulation <- "lavaan"
options$estimator <- "default"
options$moderationProbes <- list(list(probePercentile = 16, value = "16"), list(probePercentile = 50,
value = "50"), list(probePercentile = 84, value = "84"))
options$pathPlotsLegend <- TRUE
options$pathPlotsColorPalette <- "colorblind"
options$processModels <- list(list(conceptualPathPlot = TRUE, independentCovariances = TRUE,
inputType = "inputVariables", mediationEffects = TRUE, mediatorCovariances = TRUE,
modelNumber = 1, modelNumberCovariates = list(), modelNumberIndependent = "",
modelNumberMediators = list(), modelNumberModeratorW = "",
modelNumberModeratorZ = "", name = "Model 1", pathCoefficients = TRUE,
processRelationships = list(list(processDependent = "contNormal",
processIndependent = "contGamma", processType = "mediators",
processVariable = "debCollin1"), list(processDependent = "contNormal",
processIndependent = "contGamma", processType = "moderators",
processVariable = "facGender")), residualCovariances = TRUE,
statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = TRUE,
localTestType = "cis", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000))
set.seed(1)
results <- jaspTools::runAnalysis("ClassicProcess", "debug", options)

refMsg <- gettext("Linear test type cannot be applied to factor variables. Choose a different test type or remove all factor variables from the model.")

msg <- results[["results"]][["localTestContainer"]][["collection"]][["localTestContainer_Model 1"]][["collection"]][["localTestContainer_Model 1_localTestTable"]][["error"]][["errorMessage"]]
expect_equal(msg, refMsg)


table <- results[["results"]][["modelSummaryTable"]][["data"]]
jaspTools::expect_equal_tables(table,
list(605.478429431628, 641.950812035461, 4, "Model 1", 100, -288.739214715814,
5))
})

test_that("Local tests work for factors with loess test type", {
options <- jaspTools::analysisOptions("ClassicProcess")
options$dependent <- "contNormal"
options$covariates <- list("contGamma", "debCollin1", "contcor1", "contNormal")
options$factors <- list("facGender")
options$statisticalPathPlotsCovariances <- TRUE
options$statisticalPathPlotsResidualVariances <- TRUE
options$errorCalculationMethod <- "standard"
options$ciLevel <- 0.95
options$naAction <- "fiml"
options$emulation <- "lavaan"
options$estimator <- "default"
options$moderationProbes <- list(list(probePercentile = 16, value = "16"), list(probePercentile = 50,
value = "50"), list(probePercentile = 84, value = "84"))
options$pathPlotsLegend <- TRUE
options$pathPlotsColorPalette <- "colorblind"
options$processModels <- list(list(conceptualPathPlot = TRUE, independentCovariances = TRUE,
inputType = "inputVariables", mediationEffects = TRUE, mediatorCovariances = TRUE,
modelNumber = 1, modelNumberCovariates = list(), modelNumberIndependent = "",
modelNumberMediators = list(), modelNumberModeratorW = "",
modelNumberModeratorZ = "", name = "Model 1", pathCoefficients = TRUE,
processRelationships = list(list(processDependent = "contNormal",
processIndependent = "contGamma", processType = "mediators",
processVariable = "debCollin1"), list(processDependent = "contNormal",
processIndependent = "contGamma", processType = "moderators",
processVariable = "facGender")), residualCovariances = TRUE,
statisticalPathPlot = TRUE, totalEffects = TRUE, localTests = TRUE,
localTestType = "cis.loess", localTestBootstrap = FALSE, localTestBootstrapSamples = 1000))
set.seed(1)
results <- jaspTools::runAnalysis("ClassicProcess", "debug", options)
table <- results[["results"]][["localTestContainer"]][["collection"]][["localTestContainer_Model 1"]][["collection"]][["localTestContainer_Model 1_localTestTable"]][["data"]]
jaspTools::expect_equal_tables(table,
list(-0.206103108541346, 0.17035274701811, "contGamma", -0.0139864082891252,
"debCollin1", "<unicode>", "<unicode>", "facGenderm", 0.0989527098094575
))
})

0 comments on commit e4434cf

Please sign in to comment.