diff --git a/DESCRIPTION b/DESCRIPTION index b9a4cefc..9a8daebb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -12,16 +12,18 @@ Encoding: UTF-8 Imports: forcats, ggplot2, - jaspBase, - jaspGraphs, lavaan, cSEM, reshape2, + jaspBase, + jaspGraphs, semPlot, semTools, stringr, tibble, - tidyr + tidyr, + SEMsens Remotes: jasp-stats/jaspBase, jasp-stats/jaspGraphs + diff --git a/R/common.R b/R/common.R index 73a60fcd..28fa0068 100644 --- a/R/common.R +++ b/R/common.R @@ -127,3 +127,435 @@ lavBootstrap <- function(fit, samples = 1000) { return(semPlotMod) } +.sa.aco <- function (data = NULL, sample.cov, sample.nobs, model, sens.model, + opt.fun, d = NULL, paths = NULL, verbose = TRUE, max.value = Inf, + max.iter = 1000, e = 1e-10, n.of.ants = 10, k = 100, q = 1e-04, + sig.level = 0.05, rate.of.conv = 0.1, measurement = FALSE, + xi = 0.5, seed = NULL, ...) { + for.n.of.sens.pars <- lavaan::lavaanify(sens.model, fixed.x = TRUE) + n.of.sens.pars <- length(for.n.of.sens.pars[which(for.n.of.sens.pars$lhs != + "phantom" & for.n.of.sens.pars$rhs == "phantom"), ]$lhs) + if (n.of.sens.pars < 2) + stop("Sensitivity model must have at least two sensitivity parameters or phantom coefficients.") + if (is.null(data)) { + old.out = lavaan::sem(model = model, sample.cov = sample.cov, + sample.nobs = sample.nobs, ...) + } + else { + old.out = lavaan::sem(model = model, data = data, ...) + } + old.par = lavaan::standardizedSolution(old.out, type = "std.all") + old.fit <- lavaan::fitMeasures(old.out) + if (!is.null(seed)) { + set.seed(seed) + } + if (is.null(paths)) { + paths <- old.par + } + if (is.character(paths)) { + paths <- lavaan::lavaanify(paths, fixed.x = TRUE) + } + e.abs <- e + e.rel <- e + eval <- 0 + iter <- 0 + last.impr <- max.iter + nl <- matrix(NA, k, k - 1) + sens.pars <- data.frame() + outcome <- vector() + model.results <- data.frame() + max.X <- rep(NA, n.of.sens.pars) + max.y <- -Inf + p.X <- vector() + sens.fit <- vector() + p <- data.frame(v = numeric(), sd = numeric(), gr = numeric()) + if (is.null(d)) { + d <- list(rep(c(-1, 1), n.of.sens.pars)) + } + else { + if (!is.list(d)) + stop("d (domain) must be in a list format; e.g.,\n d = list(-1, 1,\n -1, 1,\n -1, 1,\n -1, 1)") + } + if (rate.of.conv <= 0 | rate.of.conv > 1) + stop("Convergence rate (rate.of.conv) must be in (0, 1]") + for (i in 1:(round(1/rate.of.conv * k, 0))) { + X <- vector() + for (j in 1:n.of.sens.pars) { + X <- c(X, stats::runif(1, d[[1]][2 * j - 1], d[[1]][2 * + j])) + } + X <- t(X) + new.model = sens.model + for (l in 1:n.of.sens.pars) { + new.model = gsub(paste("phantom", l, sep = ""), paste(X[l]), + new.model, ignore.case = FALSE, perl = FALSE, + fixed = FALSE, useBytes = FALSE) + } + iter <- iter + 1 + if((2 * k) < max.iter) + progressbarTick() + + warnings <- options(warn = 2) + if (is.null(data)) { + new.out = try(lavaan::sem(model = new.model, sample.cov = sample.cov, + sample.nobs = sample.nobs, ...), silent = TRUE) + } + else { + new.out = try(lavaan::sem(model = new.model, data = data, + ...), silent = TRUE) + } + if (isTRUE(class(new.out) == "try-error")) { + next + } + on.exit(options(warnings)) + new.par = lavaan::standardizedSolution(new.out, type = "std.all") + eval <- eval + 1 + if((2 * k) >= max.iter) + progressbarTick() + + new.par$lines <- 1:length(new.par[, 1]) + new.par$evals <- eval + model.results <- rbind(model.results, new.par) + if (eval == 1) { + sens.out <- new.out + model.1 <- model.results + model.1$path <- paste(model.1$lhs, model.1$op, model.1$rhs, + sep = "") + phan.names <- model.1[which(model.1$evals == 1 & + model.1$op == "~" & model.1$rhs == "phantom"), + ]$path + if (is.data.frame(paths)) { + if (measurement) { + paths <- which(model.1$lhs %in% paths$lhs & + model.1$rhs %in% paths$rhs) + } + else { + paths <- which(model.1$lhs %in% paths$lhs & + model.1$op == "~" & model.1$rhs %in% paths$rhs) + } + } + } + sens.par <- c(X, eval = eval) + sens.pars <- rbind(sens.pars, sens.par) + fit <- c(lavaan::fitMeasures(new.out), eval = eval) + sens.fit <- rbind(sens.fit, fit) + if (!is.numeric(opt.fun)) { + y <- eval(opt.fun) + } + else if (opt.fun == 1) { + y <- mean(abs(old.par$est[paths]), na.rm = TRUE)/mean(abs(new.par$est[paths]), + na.rm = TRUE) + } + else if (opt.fun == 2) { + y <- stats::sd(new.par$est[paths] - old.par$est[paths], + na.rm = TRUE)/mean(abs(old.par$est[paths]), na.rm = TRUE) + } + else if (opt.fun == 3) { + y <- mean(abs(new.par$pvalue[paths] - old.par$pvalue[paths]), + na.rm = TRUE) + } + else if (opt.fun == 4) { + y <- 1/mean(abs(new.par$pvalue[paths] - rep(sig.level, + length(paths))), na.rm = TRUE) + } + else if (opt.fun == 5) { + y <- abs(unname(lavaan::fitmeasures(new.out)["rmsea"]) - + unname(lavaan::fitmeasures(old.out)["rmsea"])) + } + else if (opt.fun == 6) { + y <- 1/abs(unname(lavaan::fitmeasures(new.out)["rmsea"]) - + 0.05) + } + outcome <- c(outcome, y) + p.X <- rbind(p.X, X) + p <- rbind(p, data.frame(v = y, sd = 0, gr = 0)) + if (eval == k) { + break + } + } + if (length(p.X) == 0 | length(p$v) < k) + .quitAnalysis("Sensitivity analysis models do not reach the specified convergence rate.\n Please set a lower convergence rate threshhold or reduce model complexicity") + p$gr <- rank(-p$v, ties.method = "random") + for (i in 1:k) { + nl[i, ] <- (1:k)[1:k != i] + } + while (TRUE) { + dist.mean <- p.X + if (sum(apply(dist.mean, 2, stats::sd)) == 0) { + colnames(sens.pars) <- c(phan.names, "eval") + return(list(n.eval = eval, n.iter = iter, max.y = max.y, + phantom.coef = max.X, old.model.par = old.par, + old.model.fit = old.fit, model = model, sens.model = sens.model, + sens.fit = sens.fit, outcome = outcome, sens.pars = sens.pars, + model.results = model.results, old.out = old.out, + sens.out = sens.out)) + } + dist.rank <- p$gr + dim(dist.mean) <- c(length(p$v), n.of.sens.pars) + o.X <- vector() + o.X <- SEMsens::gen.sens.pars(dist.mean, dist.rank, n.of.ants, + nl, q, k, xi) + if (length(o.X) == 0) { + colnames(sens.pars) <- c(phan.names, "eval") + return(list(n.eval = eval, n.iter = iter, max.y = max.y, + phantom.coef = max.X, old.model.par = old.par, + old.model.fit = old.fit, model = model, sens.model = sens.model, + sens.fit = sens.fit, outcome = outcome, sens.pars = sens.pars, + model.results = model.results, old.out = old.out, + sens.out = sens.out)) + } + X <- o.X + dim(X) <- c(length(X)/n.of.sens.pars, n.of.sens.pars) + for (j in 1:dim(X)[1]) { + X.sens <- X[j, ] + X.model <- as.vector(X.sens) + new.model = sens.model + for (i in 1:dim(X)[2]) { + new.model = gsub(paste("phantom", i, sep = ""), + paste(X.model[i]), new.model, ignore.case = FALSE, + perl = FALSE, fixed = FALSE, useBytes = FALSE) + } + iter <- iter + 1 + if((2 * k) < max.iter) + progressbarTick() + + warnings <- options(warn = 2) + on.exit(options(warnings)) + if (is.null(data)) { + new.out = try(lavaan::sem(model = new.model, + sample.cov = sample.cov, sample.nobs = sample.nobs, + ...), TRUE) + } + else { + new.out = try(lavaan::sem(model = new.model, + data = data, ...), TRUE) + } + if (isTRUE(class(new.out) != "try-error")) { + new.par <- lavaan::standardizedSolution(new.out, + type = "std.all") + eval <- eval + 1 + if((2 * k) >= max.iter) + progressbarTick() + + p.X <- rbind(p.X, X.sens) + new.par$lines <- 1:length(new.par[, 1]) + new.par$evals <- eval + model.results <- rbind(model.results, new.par) + fit <- c(lavaan::fitMeasures(new.out), eval = eval) + sens.fit <- rbind(sens.fit, fit) + sens.par <- c(X.sens, eval = eval) + sens.pars <- rbind(sens.pars, sens.par) + if (!is.numeric(opt.fun)) { + y <- eval(opt.fun) + } + else if (opt.fun == 1) { + y <- mean(abs(old.par$est[paths]), na.rm = TRUE)/mean(abs(new.par$est[paths]), + na.rm = TRUE) + } + else if (opt.fun == 2) { + y <- stats::sd(new.par$est[paths] - old.par$est[paths], + na.rm = TRUE)/mean(abs(old.par$est[paths]), + na.rm = TRUE) + } + else if (opt.fun == 3) { + y <- mean(abs(new.par$pvalue[paths] - old.par$pvalue[paths]), + na.rm = TRUE) + } + else if (opt.fun == 4) { + y <- 1/mean(abs(new.par$pvalue[paths] - rep(sig.level, + length(paths))), na.rm = TRUE) + } + else if (opt.fun == 5) { + y <- abs(unname(lavaan::fitmeasures(new.out)["rmsea"]) - + unname(lavaan::fitmeasures(old.out)["rmsea"])) + } + else if (opt.fun == 6) { + y <- abs(unname(lavaan::fitmeasures(new.out)["rmsea"]) - + 0.05) + } + outcome <- c(outcome, y) + p <- rbind(p, data.frame(v = y, sd = 0, gr = 0)) + p$gr <- rank(-p$v, ties.method = "random") + idx.final <- p$gr <= k + p <- p[idx.final, ] + p.X <- p.X[idx.final, ] + dim(p.X) <- c(length(p.X)/n.of.sens.pars, n.of.sens.pars) + } + } + p$gr <- rank(-p$v, ties.method = "random") + for (i in 1:k) { + nl[i, ] <- (1:k)[1:k != i] + } + if (max(outcome, na.rm = TRUE) > max.y) { + max.y <- max(outcome, na.rm = TRUE) + max.X <- sens.pars[which.max(outcome), ] + colnames(max.X) <- c(phan.names, "eval") + last.impr <- eval + } + if ((abs(max.y - max.value) < abs(e.rel * max.value + + e.abs)) | (max.y > max.value)) { + colnames(sens.pars) <- c(phan.names, "eval") + return(list(n.eval = eval, n.iter = iter, max.y = max.y, + phantom.coef = max.X, old.model.par = old.par, + old.model.fit = old.fit, model = model, sens.model = sens.model, + sens.fit = sens.fit, outcome = outcome, sens.pars = sens.pars, + model.results = model.results, old.out = old.out, + sens.out = sens.out)) + } + if (max.iter > 0 & iter >= max.iter) { + colnames(sens.pars) <- c(phan.names, "eval") + return(list(n.eval = eval, n.iter = iter, max.y = max.y, + phantom.coef = max.X, old.model.par = old.par, + old.model.fit = old.fit, model = model, sens.model = sens.model, + sens.fit = sens.fit, outcome = outcome, sens.pars = sens.pars, + model.results = model.results, old.out = old.out, + sens.out = sens.out)) + } + } +} + +.sa.tabu <- function (model, sens.model, data = NULL, sample.cov = NULL, + sample.nobs = NULL, opt.fun = 1, sig.level = 0.05, ...) { + init.model <- model + init.model.par.table <- lavaan::lavaanify(init.model, auto = T, + model.type = "sem", fixed.x = TRUE) + non.phan.path.ids <- which(init.model.par.table$op == "~") + non.phan.path.names <- character(length(non.phan.path.ids)) + for (i in seq_along(non.phan.path.ids)) { + j <- non.phan.path.ids[i] + non.phan.path.names[i] <- paste(init.model.par.table$lhs[j], + init.model.par.table$op[j], init.model.par.table$rhs[j]) + } + sens.model.par.table <- lavaan::lavaanify(sens.model, auto = T, + model.type = "sem", fixed.x = TRUE) + phan.path.ids <- which(sens.model.par.table$label != "") + phan.path.names <- character(length(phan.path.ids)) + for (i in seq_along(phan.path.ids)) { + j <- phan.path.ids[i] + phan.path.names[i] <- paste(sens.model.par.table$lhs[j], + sens.model.par.table$op[j], sens.model.par.table$rhs[j]) + } + init.model.sem <- lavaan::sem(model = init.model.par.table, + data = data, sample.cov = sample.cov, sample.nobs = sample.nobs) + init.model.params <- lavaan::standardizedSolution(init.model.sem, + type = "std.all") + sens.model.template <- sens.model + f <- function(phantom.coef) { + for (j in 1:length(phantom.coef)) { + sens.model.template <- gsub(paste0("phantom", j), + paste(phantom.coef[j]), sens.model.template) + } + sens.model.template.par.table <- lavaan::lavaanify(sens.model.template, + auto = T, model.type = "sem", fixed.x = TRUE) + sens.model.sem <- try(lavaan::sem(model = sens.model.template.par.table, + data = data, sample.cov = sample.cov, sample.nobs = sample.nobs), + silent = TRUE) + sens.model.params <- lavaan::standardizedSolution(sens.model.sem, + type = "std.all") + if (opt.fun == 1) { + y <- mean(abs(sens.model.params$est[non.phan.path.ids] - + init.model.params$est[non.phan.path.ids]), na.rm = TRUE)/mean(abs(init.model.params$est[non.phan.path.ids]), + na.rm = TRUE) + } + else if (opt.fun == 2) { + y <- stats::sd(sens.model.params$est[non.phan.path.ids] - + init.model.params$est[non.phan.path.ids], na.rm = TRUE)/mean(abs(init.model.params$est[non.phan.path.ids]), + na.rm = TRUE) + } + else if (opt.fun == 3) { + y <- mean(abs(sens.model.params$pvalue[non.phan.path.ids] - + init.model.params$pvalue[non.phan.path.ids]), + na.rm = TRUE) + } + else if (opt.fun == 4) { + y <- mean(abs(sens.model.params$pvalue[non.phan.path.ids] - + rep(sig.level, length(non.phan.path.ids))), na.rm = TRUE) + } + else if (opt.fun == 5) { + y <- abs(unname(lavaan::fitmeasures(sens.model.sem)["rmsea"]) - + unname(lavaan::fitmeasures(init.model.sem)["rmsea"])) + } + else if (opt.fun == 6) { + y <- abs(unname(lavaan::fitmeasures(sens.model.sem)["rmsea"]) - + 0.05) + } + return(list(y = y, model = sens.model.params)) + } + res <- .sa.tabu.helper(length(phan.path.ids), f, maximum = TRUE, + ...) + colnames(res$best.param) <- phan.path.names + out <- list(model = model, old.model.par = init.model.params, + model.results = res$model.history, best.param = res$best.param[1, + ], best.obj = res$best.obj, sens.par = NULL, outcome = NULL) + return(out) +} + +.sa.tabu.helper <- function (n.var, f, maximum = FALSE, max.len = 1, max.tabu.size = 5, + neigh.size = NULL, max.iter = NULL, max.iter.obj = NULL, + range = c(-1, 1), r = 1e-05, verbose = TRUE, seed = NULL) +{ + if (is.null(neigh.size)) { + neigh.size <- min(n.var * 2, 10) + } + if (is.null(max.iter)) { + max.iter <- n.var * 50 + } + if (is.null(max.iter.obj)) { + max.iter.obj <- n.var * 5 + } + options(warn = 2) + tabu.list <- list() + n.iter <- 1 + n.iter.obj <- 1 + model.history <- list() + max.attempts <- 50 + if (!is.null(seed)) { + set.seed(seed) + } + for (i in 1:max.attempts) { + best.param <- current.param <- t(stats::runif(n.var, + -1, 1)) + best.obj <- try(f(best.param), silent = TRUE) + if (class(best.obj)[1] != "try-error") { + break + } + } + if (class(best.obj)[1] == "try-error") { + .quitAnalysis("Can't find a valid set of initial parameters for the sensitivity analysis! Maybe try a different seed?") + } + best.obj <- best.obj$y + tabu.list[[1]] <- current.param + if (verbose) { + cat(" n curr_obj best_obj\n") + } + while ((n.iter <= max.iter) & (n.iter.obj <= max.iter.obj)) { + best.neighbor <- SEMsens::gen.neighbors.tabu(current.param, maximum, + neigh.size, tabu.list, max.len, range, r, f) + current.param <- best.neighbor$best.param + current.obj <- best.neighbor$best.obj + best.neighbor$best.model$evals <- n.iter + model.history[[n.iter]] <- best.neighbor$best.model + if ((maximum & current.obj > best.obj) || (!maximum & + current.obj < best.obj)) { + best.obj <- current.obj + best.param <- current.param + n.iter.obj <- 1 + } + else { + n.iter.obj <- n.iter.obj + 1 + } + tabu.list <- append(tabu.list, list(current.param)) + if (length(tabu.list) > max.tabu.size) { + tabu.list <- tabu.list[-1] + } + if (verbose) { + cat(sprintf("%3d %10f %10f\n", n.iter, current.obj, + best.obj)) + } + n.iter <- n.iter + 1 + progressbarTick() + } + return(list(best.param = best.param, best.obj = best.obj, + model.history = do.call(rbind, model.history))) +} + diff --git a/R/sem.R b/R/sem.R index 99dacfe7..0140ba63 100644 --- a/R/sem.R +++ b/R/sem.R @@ -1,3 +1,5 @@ + + # # Copyright (C) 2013-2020 University of Amsterdam # @@ -41,6 +43,7 @@ SEMInternal <- function(jaspResults, dataset, options, ...) { .semMardiasCoefficient(modelContainer, dataset, options, ready) .semCov(modelContainer, dataset, options, ready) .semMI(modelContainer, datset, options, ready) + .semSensitivity(modelContainer, dataset, options, ready) .semPathPlot(modelContainer, dataset, options, ready) } @@ -241,7 +244,6 @@ checkLavaanModel <- function(model, availableVars) { # where possible, prefill results with old results results[seq_along(reuse)] <- oldresults[reuse] } - # generate lavaan options list lavopts <- .semOptionsToLavOptions(options, dataset) @@ -471,7 +473,8 @@ checkLavaanModel <- function(model, availableVars) { } .semEffectsSyntax <- function(originalSyntax, syntaxTable, regressions, dataset, options) { - if(options[["group"]] == "") { + + if(options[["group"]] == "") { regressionLabels <- letters[1:nrow(regressions)] if (!any(syntaxTable[, "label"] %in% regressionLabels)) { regressions[, "label"] <- letters[1:nrow(regressions)] @@ -588,7 +591,7 @@ checkLavaanModel <- function(model, availableVars) { for (label in 1:length(indirect_effects_splitted[[effect]])) { if (label == 1) { pred <- c(pred, regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "rhs"]) - effect_name <- paste0(regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "rhs"], "_", regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "lhs"], "_ ", groups[group]) + effect_name <- paste0(regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "rhs"], "_", regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "lhs"], "_", groups[group]) } else if (label == length(indirect_effects_splitted[[effect]])) { out <- c(out, regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "lhs"]) effect_name <- paste0(effect_name, "_", regressions[[group]][regressions[[group]]$label == indirect_effects_splitted[[effect]][[label]], "lhs"]) @@ -605,7 +608,7 @@ checkLavaanModel <- function(model, availableVars) { for (pred in unique(c(pred,regressions[[group]][["rhs"]]))) { for (out in unique(c(out, regressions[[group]][["lhs"]]))) { total_effect <- NULL - total_effect_name <- paste0("total_ ", groups[group], "_", pred, "_", out) + total_effect_name <- paste0("total_", groups[group], "_", pred, "_", out) indirect_effect_idx <- unlist(lapply(names(indirect_effects), function(x) { startsWith(x, pred) && endsWith(x, out) })) @@ -2469,6 +2472,294 @@ checkLavaanModel <- function(model, availableVars) { return() } +.semSensitivity <- function(modelContainer, dataset, options, ready) { + if (!options[["sensitivityAnalysis"]] || !is.null(modelContainer[["sensitivity"]])) return() + + sensitivity <- createJaspContainer(gettext("Sensitivity analysis")) + sensitivity$position <- 4.1 + sensitivity$dependOn(c("sensitivityAnalysis", "searchAlgorithm", "optimizerFunction", "sizeOfSolutionArchive", "numberOfAnts", "alpha", "maxIterations", "setSeed", "seed", "models")) + + modelContainer[["sensitivity"]] <- sensitivity + + if (length(options[["models"]]) < 2) { + .semSensitivityTables(modelContainer[["results"]][["object"]][[1]], NULL, sensitivity, dataset, options, ready) + } else { + + for (i in seq_along(options[["models"]])) { + fit <- modelContainer[["results"]][["object"]][[i]] + model <- options[["models"]][[i]] + .semSensitivityTables(fit, model, sensitivity, dataset, options, ready) + } + } +} + +.semSensitivityTables <- function(fit, model, parentContainer, dataset, options, ready) { + if (is.null(model)) { + sencont <- parentContainer + } else { + sencont <- createJaspContainer(model[["name"]], initCollapsed = TRUE) + } + + + # Summary of sensitivity analysis + sensumtab <- createJaspTable(title = gettext("Summary of sensitivity analysis")) + + if (options[["group"]] != "") + sensumtab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) + + sensumtab$addColumnInfo(name = "path", title = gettext("Path"), type = "string") + sensumtab$addColumnInfo(name = "est", title = gettext("Standardized estimate"), overtitle = gettext("Original model"), type = "number") + sensumtab$addColumnInfo(name = "pvalue", title = gettext("p"), overtitle = gettext("Original model"), type = "pvalue") + sensumtab$addColumnInfo(name = "pvaluesens", title = gettext("p\u002A"), overtitle = gettext("Sensitivity model"), type = "pvalue") + sensumtab$addColumnInfo(name = "mean", title = gettext("Mean"), overtitle = gettext("Sensitivity model"), type = "number") + sensumtab$addColumnInfo(name = "min", title = gettext("Min"), overtitle = gettext("Sensitivity model"), type = "number") + sensumtab$addColumnInfo(name = "max", title = gettext("Max"), overtitle = gettext("Sensitivity model"), type = "number") + + sencont[["sensum"]] <- sensumtab + + if (!ready || !inherits(fit, "lavaan")) return() + + # create SEMsens model + if (is.null(model)) { + analyticModel <- .semTranslateModel(options[["models"]][[1]][["syntax"]], dataset) + } else { + analyticModel <- .semTranslateModel(model[["syntax"]], dataset) + } + #enrich model + modelTable <- lavaan::lavInspect(fit, what = "list") + pathVars <- unique(c(modelTable[modelTable$op == "~", ]$rhs, modelTable[modelTable$op == "~", ]$lhs)) + + if (length(pathVars) < 2) { + .quitAnalysis(gettext("Please include at least one regression path in the model to perform a sensitivity analysis.")) + } + + sensModel <- analyticModel + for (i in seq_along(pathVars)) { + sensParameter <- paste0("\n", pathVars[i], " ~", " phantom", i, "*phantom\n") + sensModel <- paste0(sensModel, sensParameter) + } + sensModel <- paste0(sensModel, "\nphantom =~ 0\nphantom ~~ 1*phantom\n") + optimizerFunction <- switch(options[["optimizerFunction"]], + "percentChangeMeanEstimate" = 1, + "sdOfDeviance" = 2, + "changeOfPvalue" = 3, + "distanceOfPvalue" = 4, + "changeOfRmsea" = 5, + "distanceOfRmsea" = 6 + ) + + if (options[["group"]] != "") { + saTables <- lapply(1:5, function(x) data.frame()) + for (group in unique(dataset[, options[["group"]]])) { + data <- dataset[dataset[[options[["group"]]]] == group,] + if(options[["searchAlgorithm"]] == "antColonyOptimization") { + iter <- ifelse((2 * options[["sizeOfSolutionArchive"]]) >= options[["maxIterations"]], (options[["sizeOfSolutionArchive"]] + options[["numberOfAnts"]]), (options[["maxIterations"]] + options[["numberOfAnts"]])) + startProgressbar(iter, + gettextf("Performing sensitivity analysis (model: %1$s, group: %2$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]), + group)) + sa <- .sa.aco(data = data, model = analyticModel, sens.model = sensModel, n.of.ants = options[["numberOfAnts"]], k = options[["sizeOfSolutionArchive"]], rate.of.conv = options[["convergenceRateThreshold"]], opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + if(options[["searchAlgorithm"]] == "tabuSearch") { + startProgressbar(options[["maxIterations"]], + gettextf("Performing sensitivity analysis (model: %1$s, group: %2$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]), + group)) + sa <- .sa.tabu(data = data, model = analyticModel, sens.model = sensModel, opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + saTablesRows <- SEMsens::sens.tables(sa) + saTablesRows <- sapply(saTablesRows, function(x) { + cbind(x, "group" = rep(group, length(x[, 1])), "rowname" = row.names(x)) + }) + for (table in seq_along(saTablesRows)) { + saTables[[table]] <- rbind(saTables[[table]], saTablesRows[[table]]) + } + } + saTables <- sapply(saTables, as.data.frame) + saTables <- sapply(saTables, function(x) {x[order(x[["group"]], x[["rowname"]]),]}) + } else { + if (options[["dataType"]] == "raw") { + if(options[["searchAlgorithm"]] == "antColonyOptimization") { + iter <- ifelse((2 * options[["sizeOfSolutionArchive"]]) >= options[["maxIterations"]], (options[["sizeOfSolutionArchive"]] + options[["numberOfAnts"]]), (options[["maxIterations"]] + options[["numberOfAnts"]])) + startProgressbar(iter, + gettextf("Performing sensitivity analysis (model: %1$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]) + )) + sa <- .sa.aco(data = dataset, model = analyticModel, sens.model = sensModel, n.of.ants = options[["numberOfAnts"]], k = options[["sizeOfSolutionArchive"]], rate.of.conv = options[["convergenceRateThreshold"]], opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + if(options[["searchAlgorithm"]] == "tabuSearch") { + startProgressbar(options[["maxIterations"]], + gettextf("Performing sensitivity analysis (model: %1$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]) + )) + sa <- .sa.tabu(data = dataset, model = analyticModel, sens.model = sensModel, opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + } else { + if (is.null(model)) { + syntax <- options[["models"]][[1]][["syntax"]] + } else { + syntax <- model[["syntax"]] + } + dataset <- .semDataCovariance(dataset, syntax) + if(options[["searchAlgorithm"]] == "antColonyOptimization") { + iter <- ifelse((2 * options[["sizeOfSolutionArchive"]]) >= options[["maxIterations"]], (options[["sizeOfSolutionArchive"]] + options[["numberOfAnts"]]), (options[["maxIterations"]] + options[["numberOfAnts"]])) + startProgressbar(iter, + gettextf("Performing sensitivity analysis (model: %1$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]) + )) + sa <- .sa.aco(sample.cov = dataset, sample.nobs = options[["sampleSize"]], model = analyticModel, sens.model = sensModel, n.of.ants = options[["numberOfAnts"]], k = options[["sizeOfSolutionArchive"]], rate.of.conv = options[["convergenceRateThreshold"]], opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + if(options[["searchAlgorithm"]] == "tabuSearch") { + startProgressbar(options[["maxIterations"]], + gettextf("Performing sensitivity analysis (model: %1$s)", + ifelse(is.null(model), + options[["models"]][[1]][["name"]], + model[["name"]]) + )) + sa <- .sa.tabu(sample.cov = dataset, sample.nobs = options[["sampleSize"]], model = analyticModel, sens.model = sensModel, opt.fun = optimizerFunction, max.iter = options[["maxIterations"]], sig.level = options[["alpha"]], seed = if (options[["setSeed"]]) options[["seed"]] else NULL) + } + } + saTables <- SEMsens::sens.tables(sa) + saTables <- sapply(saTables, function(x) { + cbind(x, "rowname" = row.names(x)) + }) + saTables <- sapply(saTables, as.data.frame) + saTables <- sapply(saTables, function(x) { + x[order(x[["rowname"]]),] + }) + } + + + # Fill table + + if (options[["group"]] != "") + sensumtab[["group"]] <- saTables[[1]][["group"]] + + sensumtab[["path"]] <- saTables[[1]][["rowname"]] + sensumtab[["est"]] <- saTables[[1]][["model.est"]] + sensumtab[["pvalue"]] <- saTables[[1]][["model.pvalue"]] + sensumtab[["pvaluesens"]] <- saTables[[5]][["p.changed"]] + sensumtab[["mean"]] <- saTables[[1]][["mean.est.sens"]] + sensumtab[["min"]] <- saTables[[1]][["min.est.sens"]] + sensumtab[["max"]] <- saTables[[1]][["max.est.sens"]] + + + # Sensitivity parameters that led to a change in significance + senpartab <- createJaspTable(title = gettext("Sensitivity parameters that led to a change in significance")) + + if (options[["group"]] != "") + senpartab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) + + senpartab$addColumnInfo(name = "path", title = gettext("Path"), type = "string") + + sensitivityParameters <- grep("~", colnames(saTables[[5]]), value = TRUE) + for (par in sensitivityParameters) { + # unfortunately the title is set by the r package and is (usually) "phantom", not sure how to translate such a thing + senpartab$addColumnInfo(name = par, title = par, overtitle = gettext("Sensitivity parameters"), type = "number") + } + + sencont[["senpar"]] <- senpartab + + # Fill table + saTable_clean <- saTables[[5]][!is.na(saTables[[5]][["p.changed"]]), ] + if (nrow(saTable_clean) == 0) sencont[["senpar"]] <- NULL + + + if (options[["group"]] != "") + senpartab[["group"]] <- saTable_clean[["group"]] + + senpartab[["path"]] <- saTable_clean[["rowname"]] + for (par in sensitivityParameters) { + senpartab[[par]] <- saTable_clean[[par]] + } + + # # Not sure why this is here??? Lorenzo would know, lets just leave it in + # # Sensitivity parameters that led to min est + # senparmintab <- createJaspTable(title = gettext("Sensitivity parameters that led to the minimum estimates in the sensitivity model")) + # + # if (options[["group"]] != "") + # senparmintab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) + # + # senparmintab$addColumnInfo(name = "path", title = gettext("Path"), type = "string") + # + # sensitivityParameters <- grep("~", colnames(saTables[[3]]), value = TRUE) + # for (par in sensitivityParameters) { + # senparmintab$addColumnInfo(name = par, title = gettext(par), overtitle = gettext("Sensitivity parameters"), type = "number") + # } + # + # sencont[["senparmin"]] <- senparmintab + # + # # Fill table + # if (options[["group"]] != "") + # senparmintab[["group"]] <- saTables[[3]][["group"]] + # + # senparmintab[["path"]] <- saTables[[3]][["rowname"]] + # for (par in sensitivityParameters) { + # senparmintab[[par]] <- saTables[[3]][[par]] + # } + + # # Sensitivity parameters that led to max est + # senparmaxtab <- createJaspTable(title = gettext("Sensitivity parameters that led to the maximum estimates in the sensitivity model")) + # + # if (options[["group"]] != "") + # senparmaxtab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) + # + # senparmaxtab$addColumnInfo(name = "path", title = gettext("Path"), type = "string") + # + # sensitivityParameters <- grep("~", colnames(saTables[[4]]), value = TRUE) + # for (par in sensitivityParameters) { + # senparmaxtab$addColumnInfo(name = par, title = gettext(par), overtitle = gettext("Sensitivity parameters"), type = "number") + # } + # + # sencont[["senparmax"]] <- senparmaxtab + # + # # Fill table + # if (options[["group"]] != "") + # senparmaxtab[["group"]] <- saTables[[4]][["group"]] + # + # senparmaxtab[["path"]] <- saTables[[4]][["rowname"]] + # for (par in sensitivityParameters) { + # senparmaxtab[[par]] <- saTables[[4]][[par]] + # } + + # Summary of sensitivity parameters + sensumpartab <- createJaspTable(title = gettext("Summary of sensitivity parameters")) + + if (options[["group"]] != "") + sensumpartab$addColumnInfo(name = "group", title = gettext("Group"), type = "string", combine = TRUE) + + sensumpartab$addColumnInfo(name = "par", title = gettext("Sensitivity parameter"), type = "string") + sensumpartab$addColumnInfo(name = "mean", title = gettext("Mean"), type = "number") + sensumpartab$addColumnInfo(name = "min", title = gettext("Min"), type = "number") + sensumpartab$addColumnInfo(name = "max", title = gettext("Max"), type = "number") + + sencont[["sensumpar"]] <- sensumpartab + + #Fill table + + if (options[["group"]] != "") + sensumpartab[["group"]] <- saTables[[2]][["group"]] + + sensumpartab[["par"]] <- saTables[[2]][["rowname"]] + sensumpartab[["mean"]] <- saTables[[2]][["mean.phan"]] + sensumpartab[["min"]] <- saTables[[2]][["min.phan"]] + sensumpartab[["max"]] <- saTables[[2]][["max.phan"]] + + if (!is.null(model)) parentContainer[[model[["name"]]]] <- sencont +} + + + .semPathPlot <- function(modelContainer, dataset, options, ready) { if (!options[["pathPlot"]] || !ready || !is.null(modelContainer[["plot"]])) return() diff --git a/inst/qml/SEM.qml b/inst/qml/SEM.qml index c709ffc7..6b8bcb8a 100644 --- a/inst/qml/SEM.qml +++ b/inst/qml/SEM.qml @@ -337,4 +337,53 @@ Section } } } -} + Section + { + title: qsTr("Sensitivity Analysis") + CheckBox + { + name: "sensitivityAnalysis" + label: qsTr("Run sensitivity analysis") + RadioButtonGroup + { + title: qsTr("Search algorithm") + name: "searchAlgorithm" + id: search + RadioButton + { + value: "antColonyOptimization" + label: qsTr("Ant colony optimization") + checked: true + IntegerField { name: "numberOfAnts"; label: qsTr("Number of ants"); defaultValue: 10 } + IntegerField { name: "sizeOfSolutionArchive"; label: qsTr("Size of the solution archive"); defaultValue: 100 } + DoubleField { name: "convergenceRateThreshold"; label: qsTr("Convergence rate threshold"); defaultValue: 0.1; negativeValues: false } + } + RadioButton { value: "tabuSearch"; label: qsTr("Tabu search") } + } + DropDown + { + name: "optimizerFunction" + label: qsTr("Optimizer function") + values: + [ + { label: qsTr("% change mean estimate") , value: "percentChangeMeanEstimate" }, + { label: qsTr("Sd of deviance / old estimate") , value: "sdOfDeviance" }, + { label: qsTr("Change of p-value") , value: "changeOfPvalue" }, + { label: qsTr("Distance of p-value from alpha") , value: "distanceOfPvalue" }, + { label: qsTr("Change of RMSEA") , value: "changeOfRmsea" }, + { label: qsTr("Distance of RMSEA from 0.05") , value: "distanceOfRmsea" } + ] + } + DoubleField + { + name: "alpha" + label: qsTr("Significance level") + negativeValues: false + decimals: 4 + defaultValue: 0.05 + } + IntegerField { name: "maxIterations"; label: qsTr("Maximum number of iterations"); defaultValue: 1000 } + SetSeed{} + } + } +} \ No newline at end of file diff --git a/tests/testthat/test-sem.R b/tests/testthat/test-sem.R index f09302bf..d657df9e 100644 --- a/tests/testthat/test-sem.R +++ b/tests/testthat/test-sem.R @@ -98,12 +98,12 @@ reliability <- container[["modelContainer_reliability"]][["data"]] test_that("reliability/ AVE/ htmt works", { expect_equal_tables(ave, list(0.8588015398276, "ind60", 0.597128239158634, "dem60", 0.640021072526866, - "dem65")) + "dem65")) expect_equal_tables(htmt, list("", "", 1, 1, "", 0.420934414880351, 0.980709420149052, 1, 0.549916280338394 )) expect_equal_tables(reliability, list("ind60", 0.902334680203148, 0.943690008441057, "dem60", 0.858794528217608, - 0.841179471771507, "dem65", 0.882739385479519, 0.857553923970666, - "total", 0.91494164193877, 0.919205517992938)) + 0.841179471771507, "dem65", 0.882739385479519, 0.857553923970666, + "total", 0.91494164193877, 0.919205517992938)) }) # Multigroup, multimodel SEM works @@ -190,428 +190,442 @@ test_that("Model fit table results match", { list(3189.26691715402, 3383.93591869107, 85.6796813843016, 70, "default", 75, 0.0980338951401504, "", "", "", "all", 3184.34803034567, 3372.06456754211, 87.9549367720077, 73, "constrained", 75, 0.111927575441422, - 0.647754490400877, 1.65156784896073, 3, "all", 3181.07183366569, + 0.647754490400879, 1.65156784896072, 3, "all", 3181.07183366569, 3361.83590652152, 92.7433708195404, 76, "more constrained", - 75, 0.0929761753673403, 0.110596895610444, 6.02091896551083, + 75, 0.0929761753673403, 0.110596895610441, 6.02091896551089, 3, "all", 1638.81154499845, 1774.12864966057, 51.603527732831, 70, "default", 37, 0.951434618744164, "", "", "", 1, 1718.45537215556, 1856.01260957258, 34.0761536514706, 70, "default", 38, 0.999909631385078, "", "", "", 2, 1633.89265814398, 1764.37700906817, 53.4279668719256, - 73, "constrained", 37, 0.958714294372556, 0.60963120104942, + 73, "constrained", 37, 0.958714294372556, 0.609631201049421, 1.82443913909461, 3, 1, 1712.45537220169, 1845.09985113953, 34.5269699000821, 73, "constrained", 38, 0.999963257835091, - 0.929556093266984, 0.450816248611524, 3, 2, 1627.89265813238, + 0.929556093266985, 0.450816248611517, 3, 2, 1627.89265813238, 1753.54425531862, 54.5525537466108, 76, "more constrained", - 37, 0.970044580307764, 0.771142273547438, 1.12458687468521, + 37, 0.970044580307764, 0.771142273547436, 1.12458687468522, 3, 1, 1709.17917553332, 1836.91089599197, 38.1908170729296, - 76, "more constrained", 38, 0.999911473827655, 0.300125123328537, - 3.66384717284747, 3, 2)) + 76, "more constrained", 38, 0.999911473827655, 0.300125123328536, + 3.66384717284748, 3, 2)) }) -test_that("Multigroup, multimodel SEM works", { - -rsquared <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] -expect_equal_tables(rsquared, list(1, "x1", 0.883076871616545, 0.88344099961725, 0.883440941017356, - 1, "x2", 0.993698159869737, 0.993307380054294, 0.993308312239008, - 1, "x3", 0.734550879193546, 0.734754000085834, 0.734752992615769, - 1, "y1", 0.76374604003533, 0.783825225382152, 0.783824495338428, - 1, "y2", 0.526988232837519, 0.469805811235219, 0.469797871843766, - 1, "y3", 0.540743668690899, 0.602813004892641, 0.602813008520997, - 1, "y4", 0.758371834315633, 0.715732725592277, 0.715727580943472, - 1, "y5", 0.74873567690424, 0.760689523184987, 0.760685788176897, - 1, "y6", 0.626089440009365, 0.636528021958327, 0.636530171924641, - 1, "y7", 0.729758226751308, 0.710375682244039, 0.71037601689489, - 1, "y8", 0.574575906571731, 0.588831799668115, 0.588835817501729, - 1, "dem60", 0.275927380324134, 0.258157185403394, 0.258145005894915, - 1, "dem65", 0.941713333219213, 0.938883931908498, 0.938882940520396, - 2, "x1", 0.787475869571125, 0.78747617521673, 0.788439850883342, - 2, "x2", 0.90066092940223, 0.900660946749863, 0.900202685338541, - 2, "x3", 0.749867733548725, 0.749868295135393, 0.749372699570588, - 2, "y1", 0.731921944773149, 0.731929437708713, 0.683849857838249, - 2, "y2", 0.550065444500199, 0.55006739915162, 0.519184271086883, - 2, "y3", 0.465824888188388, 0.465819890503162, 0.543696244446076, - 2, "y4", 0.651968126202522, 0.651959003998254, 0.694898810552775, - 2, "y5", 0.536001769615456, 0.535995620432757, 0.598318029638657, - 2, "y6", 0.625808175301569, 0.625823134164411, 0.607599332020539, - 2, "y7", 0.658946836103404, 0.658945492261667, 0.618117097165422, - 2, "y8", 0.842442637402788, 0.842449295416932, 0.821972120799197, - 2, "dem60", 0.0753599955960172, 0.0753581296999281, 0.0905522598180797, - 2, "dem65", 0.956917027167473, 0.956910675588687, 0.977886505597527), "R-squared table") - -mardia <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_mardiasTable"]][["data"]] -expect_equal_tables(mardia, list(330.8978096739, 26.471824773912, 286, "Skewness", 0.0347860345067638, - "", "", 134.567190822067, "", "Kurtosis", 0.0308358026617131, - -2.15918518879414), "Mardia's coefficient table") - -# parameter tables (use only the most constrained one, model 3) -parcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][[3]][["collection"]] - -parcov <- parcont[["modelContainer_params_more constrained_cov"]][["data"]] -parind <- parcont[["modelContainer_params_more constrained_ind"]][["data"]] -parlvar <- parcont[["modelContainer_params_more constrained_lvar"]][["data"]] -parmu <- parcont[["modelContainer_params_more constrained_mu"]][["data"]] -parreg <- parcont[["modelContainer_params_more constrained_reg"]][["data"]] -parvar <- parcont[["modelContainer_params_more constrained_var"]][["data"]] -partoteff <- parcont[["modelContainer_params_more constrained_toteff"]][["data"]] -parindeff <- parcont[["modelContainer_params_more constrained_indeff"]][["data"]] - -expect_equal_tables(parcov, list(-0.6954531542207, 1.13004177555805, 0.217294310668675, 1, "", - "y1 - y5", 0.640785259230165, 0.465696039360422, 0.122229400273098, - 0.217294310668675, 0.122229400273098, 0.466601156769773, 0.433556460847837, - 4.21291697813377, 2.3232367194908, 1, "", "y2 - y4", 0.0159680098210626, - 0.964140297244501, 0.551561502186759, 2.3232367194908, 0.551561502186759, - 2.40964590540462, -0.453419237958842, 2.505951236881, 1.02626599946108, - 1, "", "y2 - y6", 0.17402837160491, 0.754955320144396, 0.193560311396125, - 1.02626599946108, 0.193560311396125, 1.35937316034119, -0.360831524130165, - 2.44595509715802, 1.04256178651393, 1, "", "y3 - y7", 0.145384170743897, - 0.716030152448658, 0.308401783418161, 1.04256178651393, 0.308401783418161, - 1.45603056372502, -1.1752514946784, 0.804530353606003, -0.185360570536198, - 1, "", "y4 - y8", 0.713611427442158, 0.505055670384933, -0.055456132680955, - -0.185360570536198, -0.055456132680955, -0.367010176115681, - -0.214945884704212, 3.12165697220468, 1.45335554375024, 1, "", - "y6 - y8", 0.0877403085916073, 0.851189839004082, 0.345429944587142, - 1.45335554375024, 0.345429944587142, 1.70743995892938, -0.118867422075107, - 1.57858876509683, 0.729860671510864, 2, "", "y1 - y5", 0.0918990888281448, - 0.433032494617569, 0.378922580175638, 0.729860671510864, 0.378922580175638, - 1.68546397922271, -0.465368071384461, 3.32132373684828, 1.42797783273191, - 2, "", "y2 - y4", 0.139348430266928, 0.966010558893349, 0.272324473644576, - 1.42797783273191, 0.272324473644576, 1.47822176433329, 0.0620106319581817, - 4.11438168212343, 2.0881961570408, 2, "", "y2 - y6", 0.0433887887248896, - 1.0337871211231, 0.353104277180419, 2.0881961570408, 0.353104277180419, - 2.01994793161304, -1.37202057656756, 2.36286703932311, 0.495423231377773, - 2, "", "y3 - y7", 0.603085629226917, 0.95279496086433, 0.102496109909358, - 0.495423231377773, 0.102496109909358, 0.519968358069766, -0.467325344619643, - 1.95619519341019, 0.744434924395273, 2, "", "y4 - y8", 0.228555681753865, - 0.618256395818049, 0.289753166031978, 0.744434924395273, 0.289753166031978, - 1.20408770443898, -0.397060222176712, 2.20355649897539, 0.903248138399338, - 2, "", "y6 - y8", 0.173364480031275, 0.663434823717536, 0.311727419658627, - 0.903248138399338, 0.311727419658627, 1.3614723046011), "Covariance parameter table") -expect_equal_tables(parind, list(1, 1, 1, 1, "a1", "dem60", "", "y1", 0, 0.885338633144645, 2.42166834175017, - 0.885338633144645, "", 0.760887096093346, 1.33133716576763, - 1.04611213093049, 1, "b1", "dem60", 6.55031584528842e-13, "y2", - 0.145525651025714, 0.685418027078195, 2.53333662939518, 0.685418027078195, - 7.18850679283783, 0.783222538721785, 1.29591955303148, 1.03957104587663, - 1, "c1", "dem60", 1.99840144432528e-15, "y3", 0.130792458012948, - 0.776410335145661, 2.51749629079955, 0.776410335145661, 7.94824917025196, - 0.796321916480285, 1.25466669817794, 1.02549430732911, 1, "d1", - "dem60", 0, "y4", 0.116926837766668, 0.846006844501551, 2.48340709870393, - 0.846006844501551, 8.77039289624442, 1, 1, 1, 1, "a1", "dem65", - "", "y5", 0, 0.872173026513029, 2.49219827699714, 0.872173026513029, - "", 0.760887096093347, 1.33133716576763, 1.04611213093049, 1, - "b1", "dem65", 6.55031584528842e-13, "y6", 0.145525651025714, - 0.797828410076152, 2.60711885025078, 0.797828410076152, 7.18850679283783, - 0.783222538721786, 1.29591955303148, 1.03957104587663, 1, "c1", - "dem65", 1.99840144432528e-15, "y7", 0.130792458012948, 0.842838072760652, - 2.59081716934986, 0.842838072760652, 7.94824917025198, 0.796321916480285, - 1.25466669817794, 1.02549430732911, 1, "d1", "dem65", 0, "y8", - 0.116926837766668, 0.767356382329443, 2.55573514579599, 0.767356382329443, - 8.77039289624441, 1, 1, 1, 1, "", "ind60", "", "x1", 0, 0.9399153903503, - 0.657997769223687, 0.9399153903503, "", 1.94762156768515, 2.55197241207641, - 2.24979698988078, 1, "", "ind60", 0, "x2", 0.154173966756102, - 0.996648539977362, 1.48036140054772, 0.996648539977362, 14.5925867850302, - 1.40827986384489, 2.23529739101974, 1.82178862743232, 1, "", - "ind60", 0, "x3", 0.21097773573858, 0.857177340236995, 1.19873285284755, - 0.857177340236995, 8.63498046869587, 1, 1, 1, 2, "a2", "dem60", - "", "y1", 0, 0.826952149666623, 1.88731847029611, 0.826952149666623, - "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, - "b2", "dem60", 1.3615824023816e-09, "y2", 0.245413370746198, - 0.720544426865466, 2.80680944160676, 0.720544426865466, 6.05995665888404, - 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", - "dem60", 9.20110654334394e-11, "y3", 0.215044298224178, 0.737357609607493, - 2.62976153946208, 0.737357609607493, 6.47952615628205, 1.13497135653258, - 1.96970928417875, 1.55234032035566, 2, "d2", "dem60", 3.10418357685194e-13, - "y4", 0.212947261845238, 0.833605908420025, 2.92976055879263, - 0.833605908420025, 7.28978765401475, 1, 1, 1, 2, "a2", "dem65", - "", "y5", 0, 0.773510200087017, 1.83190459395535, 0.773510200087017, - "", 1.00619302224548, 1.96819575821973, 1.4871943902326, 2, - "b2", "dem65", 1.3615824023816e-09, "y6", 0.245413370746198, - 0.779486582322325, 2.72439823557173, 0.779486582322325, 6.05995665888404, - 0.971906075502799, 1.81486423470296, 1.39338515510288, 2, "c2", - "dem65", 9.20110654334394e-11, "y7", 0.215044298224178, 0.786204233749362, - 2.55254866678216, 0.786204233749362, 6.47952615628205, 1.13497135653258, - 1.96970928417875, 1.55234032035566, 2, "d2", "dem65", 3.10418357685194e-13, - "y8", 0.212947261845238, 0.906626781426181, 2.84373936424167, - 0.906626781426181, 7.28978765401476, 1, 1, 1, 2, "", "ind60", - "", "x1", 0, 0.887941355542888, 0.569877660945511, 0.887941355542888, - "", 1.83150200846409, 2.88878207416714, 2.36014204131561, 2, - "", "ind60", 0, "x2", 0.269719258629941, 0.948790116589829, - 1.34499222600411, 0.948790116589829, 8.75036529947522, 1.44864109706262, - 2.4658864657564, 1.95726378140951, 2, "", "ind60", 4.61852778244065e-14, - "x3", 0.259506138050923, 0.865663155950736, 1.11540090560302, - 0.865663155950736, 7.54226391757035), "Loadings parameter table") -expect_equal_tables(parlvar, list(0.209581796157056, 0.656340332449642, "ind60", 0.432961064303349, - 1, "", "ind60", 0.000145359164061443, 0.113971108606219, 1, - 1, 1, 3.79886683211329, 1.81562506860136, 6.88555885899937, - "dem60", 4.35059196380036, 1, "", "dem60", 0.000768902080227507, - 1.29337422278904, 0.741854994105085, 0.741854994105085, 0.741854994105085, - 3.3637534188819, -0.373266498808562, 1.1324689986252, "dem65", - 0.379601249908318, 1, "", "dem65", 0.323041135527759, 0.384123256679921, - 0.0611170594796042, 0.0611170594796042, 0.0611170594796042, - 0.988227719376618, 0.139438652248914, 0.51008244464054, "ind60", - 0.324760548444727, 2, "", "ind60", 0.000593282653738703, 0.0945537253018976, - 1, 1, 1, 3.43466687756415, 1.1885891662882, 5.29026380193365, - "dem60", 3.23942648411092, 2, "", "dem60", 0.00196225561471564, - 1.04636479751642, 0.90944774018192, 0.90944774018192, 0.90944774018192, - 3.09588634078651, -0.343713422100036, 0.492133643448633, "dem65", - 0.0742101106742985, 2, "", "dem65", 0.727819060322371, 0.213230210386957, - 0.0221134944024726, 0.0221134944024726, 0.0221134944024726, - 0.348028126688176), "Latent variance parameter table") -expect_equal_tables(parmu, list(5.114583249089, 5.56572485901911, 5.34015405405405, 1, "", "x1", - 0, 0.115089260182496, 7.62813069741675, 5.34015405405405, 7.62813069741675, - 46.4001075824643, 4.69962810017044, 5.65682865658632, 5.17822837837838, - 1, "", "x2", 0, 0.244188302429574, 3.48622556023865, 5.17822837837838, - 3.48622556023865, 21.2058822099876, 3.4912357243792, 4.39245184318836, - 3.94184378378378, 1, "", "x3", 0, 0.229906295706921, 2.81869239020784, - 3.94184378378378, 2.81869239020784, 17.145436455593, 5.0659390403021, - 6.8286555542925, 5.9472972972973, 1, "", "y1", 0, 0.449680843090609, - 2.17427463923019, 5.9472972972973, 2.17427463923019, 13.2255963060871, - 2.8433068923923, 5.22515797247257, 4.03423243243243, 1, "", - "y2", 3.1510793974121e-11, 0.607626236723739, 1.09149948827483, - 4.03423243243243, 1.09149948827483, 6.6393321891178, 5.71017508116214, - 7.79973464856759, 6.75495486486486, 1, "", "y3", 0, 0.533060705167961, - 2.08326693059709, 6.75495486486486, 2.08326693059709, 12.6720180260454, - 4.36666487548144, 6.25836052992396, 5.3125127027027, 1, "", - "y4", 0, 0.482584289651232, 1.80978064785815, 5.3125127027027, - 1.80978064785815, 11.0084659128504, 4.76881059441114, 6.61024886504832, - 5.68952972972973, 1, "", "y5", 0, 0.469763292887578, 1.99111539784598, - 5.68952972972973, 1.99111539784598, 12.1114821355174, 1.69721605838774, - 3.80307150917983, 2.75014378378378, 1, "", "y6", 3.0678012175045e-07, - 0.537217894666127, 0.841596785005017, 2.75014378378378, 0.841596785005017, - 5.11923338944798, 5.40096255495839, 7.38189582341999, 6.39142918918919, - 1, "", "y7", 0, 0.505349405419424, 2.07924353896195, 6.39142918918919, - 2.07924353896195, 12.6475446901625, 3.28677224232016, 5.43309959551768, - 4.35993591891892, 1, "", "y8", 1.77635683940025e-15, 0.547542549283426, - 1.30906547943089, 4.35993591891892, 1.30906547943089, 7.96273444798913, - 0, 0, 0, 1, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", - "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 1, "", "dem65", "", 0, - 0, 0, 0, "", 4.57207725542129, 4.9801932708945, 4.77613526315789, - 2, "", "x1", 0, 0.10411314154045, 7.44182183380953, 4.77613526315789, - 7.44182183380953, 45.8744707199359, 3.96560094944749, 4.86703905055251, - 4.41632, 2, "", "x2", 0, 0.229962924884195, 3.11537917222519, - 4.41632, 3.11537917222519, 19.204486993823, 2.77397157389089, - 3.59331947874069, 3.18364552631579, 2, "", "x3", 0, 0.209021163478693, - 2.47082875753002, 3.18364552631579, 2.47082875753002, 15.2312113918566, - 4.2690970296885, 5.72037665452202, 4.99473684210526, 2, "", - "y1", 0, 0.370231197175312, 2.18850630331085, 4.99473684210526, - 2.18850630331085, 13.4908589017153, 3.23427002973344, 5.71134102289814, - 4.47280552631579, 2, "", "y2", 1.46083145580178e-12, 0.631917477235172, - 1.14822725286081, 4.47280552631579, 1.14822725286081, 7.07814815612578, - 5.24236503773425, 7.51026812016048, 6.37631657894737, 2, "", - "y3", 0, 0.578557335827383, 1.787852426998, 6.37631657894737, - 1.787852426998, 11.0210625362286, 2.49773616542863, 4.73263378193979, - 3.61518497368421, 2, "", "y4", 2.28425278692157e-10, 0.570137419396414, - 1.02862998310564, 3.61518497368421, 1.02862998310564, 6.3409010717302, - 3.84453746449672, 5.35053095655592, 4.59753421052632, 2, "", - "y5", 0, 0.384189072844778, 1.94127992190503, 4.59753421052632, - 1.94127992190503, 11.9668531342739, 2.0887392465132, 4.31127233243417, - 3.20000578947368, 2, "", "y6", 1.66224263242753e-08, 0.566983144448578, - 0.915564231278779, 3.20000578947368, 0.915564231278779, 5.64391696791245, - 4.97396373438834, 7.03851152876955, 6.00623763157895, 2, "", - "y7", 0, 0.526680033578704, 1.84996647323673, 6.00623763157895, - 1.84996647323673, 11.4039592326437, 2.73789322525061, 4.73245519580203, - 3.73517421052632, 2, "", "y8", 2.1227464230833e-13, 0.508826179022745, - 1.19082958696484, 3.73517421052632, 1.19082958696484, 7.34076658103582, - 0, 0, 0, 2, "", "ind60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", - "dem60", "", 0, 0, 0, 0, "", 0, 0, 0, 2, "", "dem65", "", 0, - 0, 0, 0, ""), "Means parameter table") -expect_equal_tables(parreg, list(0.721100887386564, 3.01873119149832, 1.86991603944244, 1, "dem60", - 0.00142166660030174, "ind60", 0.586140950097851, 0.508079723955714, - 0.508079723955714, 0.508079723955714, 3.19021566251304, 0.478026990501928, - 1.96570674995725, 1.22186687022959, 1, "dem65", 0.00128400773281667, - "ind60", 0.379517116434269, 0.322601007439955, 0.322601007439955, - 0.322601007439955, 3.21953033820864, 0.572218807581072, 1.00102151163503, - 0.78662015960805, 1, "dem65", 6.43485265072741e-13, "dem60", - 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, - 7.19093964552485, -0.154169499851477, 2.14733425618112, 0.99658237816482, - 2, "dem60", 0.0896244560523969, "ind60", 0.587129093745232, - 0.300919025350807, 0.300919025350807, 0.300919025350807, 1.69738203877401, - -0.115343312911686, 0.965518339191284, 0.425087513139799, 2, - "dem65", 0.12315820352967, "ind60", 0.275735079988375, 0.132238260925043, - 0.132238260925043, 0.132238260925043, 1.54165191152943, 0.730849486044932, - 1.09592060871138, 0.913385047378158, 2, "dem65", 0, "dem60", - 0.0931320997595074, 0.941014327982574, 0.941014327982574, 0.941014327982574, - 9.80741387488061), "Regressions parameter table") -expect_equal_tables(parvar, list(0.019971862523661, 0.0942758067618645, "x1", 0.0571238346427628, - 1, "", "x1", 0.00258179957955118, 0.0189554361264553, 0.116559058982644, - 0.0571238346427628, 0.116559058982644, 3.01358587909447, -0.119066895021194, - 0.148593743772327, "x2", 0.0147634243755663, 1, "", "x2", 0.828822156218558, - 0.0682820299007519, 0.00669168776099212, 0.0147634243755663, - 0.00669168776099212, 0.216212441209275, 0.265760017116629, 0.77173003351152, - "x3", 0.518745025314075, 1, "", "x3", 5.84703635451156e-05, - 0.129076355582531, 0.265247007384231, 0.518745025314075, 0.265247007384231, - 4.01890046378318, 0.416929012723307, 2.81786755996509, "y1", - 1.6173982863442, 1, "", "y1", 0.00827424337847726, 0.612495578025943, - 0.216175504661572, 1.6173982863442, 0.216175504661572, 2.64066932786197, - 3.64229436414009, 10.8436303032633, "y2", 7.24296233370169, - 1, "", "y2", 8.06075272521412e-05, 1.8371092519879, 0.530202128156234, - 7.24296233370169, 0.530202128156234, 3.94258660766322, 1.93231536174354, - 6.41948442904567, "y3", 4.17589989539461, 1, "", "y3", 0.000264281837194513, - 1.1447070208168, 0.397186991479003, 4.17589989539461, 0.397186991479003, - 3.64800758574445, 0.931737730528367, 3.96732278343115, "y4", - 2.44953025697976, 1, "", "y4", 0.00156076961142304, 0.774398171815168, - 0.284272419056528, 2.44953025697976, 0.284272419056528, 3.16314054724345, - 0.731947613472583, 3.17608668229141, "y5", 1.95401714788199, - 1, "", "y5", 0.00172519104089064, 0.623516321753329, 0.239314211823103, - 1.95401714788199, 0.239314211823103, 3.13386687679209, 1.83678103920313, - 5.92570847199455, "y6", 3.88124475559884, 1, "", "y6", 0.000198569846390217, - 1.04311290029928, 0.363469828075359, 3.88124475559884, 0.363469828075359, - 3.72082902482106, 1.19521510119136, 4.2780912840873, "y7", 2.73665319263933, - 1, "", "y7", 0.000501976062955434, 0.786462457273012, 0.28962398310511, - 2.73665319263933, 0.28962398310511, 3.47969972035084, 2.19176630693849, - 6.93007982455653, "y8", 4.56092306574751, 1, "", "y8", 0.000161182628549028, - 1.20877565990836, 0.411164182498271, 4.56092306574751, 0.411164182498271, - 3.7731757984714, 0.0313581547372507, 0.142926262721349, "x1", - 0.0871422087292997, 2, "", "x1", 0.00220063448354591, 0.0284617750285549, - 0.211560149116658, 0.0871422087292997, 0.211560149116658, 3.06172783116557, - -0.0362625145249454, 0.437358296920339, "x2", 0.200547891197697, - 2, "", "x2", 0.0969472731768826, 0.120823855739479, 0.0997973146614593, - 0.200547891197697, 0.0997973146614593, 1.65983687551007, 0.174335809406066, - 0.65785418558488, "x3", 0.416094997495473, 2, "", "x3", 0.000742674694836687, - 0.123348791098394, 0.250627300429412, 0.416094997495473, 0.250627300429412, - 3.37332043378973, 0.67728943233645, 2.61617514252359, "y1", - 1.64673228743002, 2, "", "y1", 0.000870742833376514, 0.494622790388198, - 0.316150142161751, 1.64673228743002, 0.316150142161751, 3.32926892862662, - 3.61992130179251, 10.9720172659021, "y2", 7.29596928384731, - 2, "", "y2", 0.000100243055731752, 1.87556914874508, 0.480815728913117, - 7.29596928384731, 0.480815728913117, 3.89000282326511, 2.80111563779673, - 8.80696575715111, "y3", 5.80404069747392, 2, "", "y3", 0.000151736573070549, - 1.53213277558357, 0.456303755553924, 5.80404069747392, 0.456303755553924, - 3.78820999718072, 1.47037447709196, 6.06693911089053, "y4", - 3.76865679399125, 2, "", "y4", 0.00130948831028421, 1.17261456589399, - 0.305101189447225, 3.76865679399125, 0.305101189447225, 3.21389218896327, - 1.06639719058268, 3.43954844740097, "y5", 2.25297281899183, - 2, "", "y5", 0.000198106085773642, 0.605406853273174, 0.401681970361344, - 2.25297281899183, 0.401681970361344, 3.72141941705974, 2.22486686951239, - 7.36215298126356, "y6", 4.79350992538798, 2, "", "y6", 0.00025457326577949, - 1.31055625314379, 0.392400667979461, 4.79350992538798, 0.392400667979461, - 3.65761478295129, 1.87928674169851, 6.1714850562742, "y7", 4.02538589898636, - 2, "", "y7", 0.000236681377467019, 1.09496866994292, 0.381882902834578, - 4.02538589898636, 0.381882902834578, 3.67625669070166, 0.346950686712466, - 3.15605228468781, "y8", 1.75150148570014, 2, "", "y8", 0.0145209073086436, - 0.716620718577785, 0.178027879200803, 1.75150148570014, 0.178027879200803, - 2.44411226230828), "(Residual) variances parameter table") -expect_equal_tables(partoteff, list(1.63130176674587, 3.75425928051304, 2.69278052362946, 1, " ind60 dem65", - 6.62397930284442e-07, 0.541580746001658, 0.710956104059294, - 0.710956104059294, 0.710956104059294, 4.97207580496447, 0.721100887386564, - 3.01873119149832, 1.86991603944244, 1, " ind60 dem60", - 0.00142166660030174, 0.586140950097851, 0.508079723955714, 0.508079723955714, - 0.508079723955714, 3.19021566251304, 0.572218807581072, 1.00102151163503, - 0.78662015960805, 1, " dem60 dem65", 6.43485265072741e-13, - 0.109390454987004, 0.764358580570299, 0.764358580570299, 0.764358580570299, - 7.19093964552485, 0.247077278790176, 2.42362463288204, 1.33535095583611, - 2, " ind60 dem65", 0.0161748412862954, 0.55525187484571, - 0.415407375342704, 0.415407375342704, 0.415407375342704, 2.40494632495778, - -0.154169499851477, 2.14733425618112, 0.99658237816482, 2, " ind60 dem60", - 0.0896244560523969, 0.587129093745232, 0.300919025350807, 0.300919025350807, - 0.300919025350807, 1.69738203877401, 0.730849486044932, 1.09592060871138, - 0.913385047378158, 2, " dem60 dem65", 0, 0.0931320997595074, - 0.941014327982574, 0.941014327982574, 0.941014327982574, 9.80741387488061), "Total effects table") -expect_equal_tables(parindeff, list(0.481357882787227, 2.46046942401251, 1.47091365339987, 1, "ind60 dem60 dem65", - 0.00357555663622788, 0.504884670544015, 0.388355096619339, 0.388355096619339, - 0.388355096619339, 2.91336564410829, -0.159005756965501, 1.97953264235812, - 0.910263442696311, 2, "ind60 dem60 dem65", - 0.0952150456736578, 0.545555534742511, 0.283169114417661, 0.283169114417661, - 0.283169114417661, 1.66850739242511), "Indirect effects table") - -# covariance tables. Use model 2, but the way this is ordered uses actually the default model -covcont <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][[2]][["collection"]] -covimp <- covcont[["modelContainer_covars_default_implied"]][["collection"]][["modelContainer_covars_default_implied_1"]][["data"]] -covobs <- covcont[["modelContainer_covars_default_observed"]][["collection"]][["modelContainer_covars_default_observed_1"]][["data"]] -covres <- covcont[["modelContainer_covars_default_residual"]][["collection"]][["modelContainer_covars_default_residual_1"]][["data"]] -covstd <- covcont[["modelContainer_covars_default_stdres"]][["collection"]][["modelContainer_covars_default_stdres_1"]][["data"]] - -expect_equal_tables(covimp, list(0.49008300563634, "", "", "", "", "", "", "", "", "", "", 0.974061924820936, - 2.20622852804642, "", "", "", "", "", "", "", "", "", 0.788491080043323, - 1.77466015582184, 1.95570584174645, "", "", "", "", "", "", - "", "", 0.835178540092752, 1.87973981648419, 1.5216261310825, - 7.64797977172544, "", "", "", "", "", "", "", 0.955666527250095, - 2.15092263069125, 1.74114526494313, 6.6837892939784, 14.5127221504755, - "", "", "", "", "", "", 0.788253740427639, 1.77412597456093, - 1.43613303237535, 5.51292920802481, 6.30825824454682, 9.62227326013948, - "", "", "", "", "", 0.904244744111686, 2.03518740934666, 1.647459034785, - 6.32415300473142, 9.23882105681506, 5.96882824654787, 9.02873362112345, - "", "", "", "", 1.14334478995368, 2.57333087773904, 2.08307951619225, - 5.82366205597868, 6.32427984118539, 5.21639829184987, 5.98398776520799, - 7.98119516009606, "", "", "", 1.18710886159188, 2.6718308559361, - 2.16281403020389, 5.73848644656917, 7.58931007411123, 5.41606756969487, - 6.21303824196686, 6.20454284533332, 10.2893215377554, "", "", - 1.25970543427747, 2.83522426425121, 2.29507897323411, 6.0894184140595, - 6.96791532513603, 6.91162808862569, 6.59299099686961, 6.58397607191045, - 6.83599243915776, 9.9403352106315, "", 1.15531617741013, 2.60027492931625, - 2.10489039267504, 5.58480055205702, 6.39049819021453, 5.27101657115423, - 5.85298682041024, 6.03837521104465, 7.68811256412372, 6.65291356937697, - 10.6193105678442), "Model-implied covariance table") - -expect_equal_tables(covobs, list(0.490082575997078, "", "", "", "", "", "", "", "", "", "", 0.973932449184952, - 2.20622591129467, "", "", "", "", "", "", "", "", "", 0.78518275394412, - 1.77565205254938, 1.95570361423433, "", "", "", "", "", "", - "", "", 0.842173686632578, 1.60646357669832, 1.14904644265887, - 7.62580350620891, "", "", "", "", "", "", "", 0.966640855417166, - 2.56661076528232, 2.30600417597728, 6.02486581738495, 14.676007521986, - "", "", "", "", "", "", 0.569651258731629, 1.29778304025924, - 0.751981605089701, 6.44636651314828, 5.79397804058276, 9.73209047934931, - "", "", "", "", "", 1.07850808055391, 2.50663181045844, 2.0195628491114, - 6.09461043973703, 9.30788611653126, 5.64475186161118, 9.01279131583053, - "", "", "", "", 1.23810412812272, 2.61063748721578, 1.81722127066318, - 5.59878435062089, 6.6520705502466, 5.03859665459321, 6.05661431962235, - 7.93189524242966, "", "", "", 1.43792308816034, 2.91763544604397, - 2.84145873393433, 5.38621551022644, 8.42865402090701, 4.21966332811402, - 6.90922843998977, 6.08535469304967, 10.3746040258343, "", "", - 1.04665319855464, 2.45836864046895, 1.77472198140307, 6.2463340788897, - 7.67698969559927, 6.73419489425259, 7.01801387855084, 6.81611022694302, - 6.30443702471928, 9.78003437719124, "", 1.23565159843141, 2.65937421505933, - 1.72765599854139, 5.4174694403214, 7.39753077439182, 4.59181056574472, - 6.45111697395995, 5.63862367744565, 7.7210072538895, 6.57011319209561, - 10.545706988345), "Observed covariance table") - -expect_equal_tables(covres, list(-4.29639262000681e-07, "", "", "", "", "", "", "", "", "", "", - -0.000129475635983867, -2.61675175305953e-06, "", "", "", "", - "", "", "", "", "", -0.00330832609920362, 0.000991896727542851, - -2.22751211431671e-06, "", "", "", "", "", "", "", "", 0.00699514653982602, - -0.273276239785871, -0.372579688423628, -0.0221762655165261, - "", "", "", "", "", "", "", 0.0109743281670703, 0.415688134591076, - 0.56485891103415, -0.65892347659345, 0.163285371510497, "", - "", "", "", "", "", -0.21860248169601, -0.476342934301688, -0.684151427285647, - 0.933437305123476, -0.514280203964063, 0.109817219209827, "", - "", "", "", "", 0.174263336442222, 0.471444401111776, 0.372103814326393, - -0.229542564994383, 0.0690650597162001, -0.324076384936694, - -0.0159423052929153, "", "", "", "", 0.094759338169033, 0.0373066094767367, - -0.265858245529067, -0.224877705357793, 0.327790709061214, -0.177801637256668, - 0.0726265544143621, -0.0492999176663993, "", "", "", 0.250814226568454, - 0.245804590107875, 0.678644703730438, -0.352270936342729, 0.839343946795778, - -1.19640424158084, 0.696190198022915, -0.119188152283651, 0.0852824880789491, - "", "", -0.213052235722835, -0.376855623782256, -0.52035699183104, - 0.156915664830205, 0.709074370463244, -0.177433194373092, 0.425022881681233, - 0.232134155032578, -0.531555414438472, -0.160300833440264, "", - 0.0803354210212817, 0.0590992857430783, -0.377234394133652, - -0.167331111735621, 1.00703258417729, -0.679206005409508, 0.598130153549711, - -0.399751533598995, 0.0328946897657785, -0.0828003772813588, - -0.073603579499208), "Residual covariance table") - -jaspTools::expect_equal_tables(covstd, - list(-4.29639261390058e-07, "", "", "", "", "", "", "", "", "", "", - -0.906062050868875, -2.61675175172726e-06, "", "", "", "", "", - "", "", "", "", -0.38600980945636, 1.26765266847845, -2.22751211365058e-06, - "", "", "", "", "", "", "", "", 0.0846242017037755, -1.78626926801858, - -1.50899731338318, -0.979353662950849, "", "", "", "", "", "", - "", 0.0462187188848366, 0.915104116857723, 1.26724625016898, - -3.10613908775842, 1.19239959132546, "", "", "", "", "", "", - -1.56053141398542, -1.98571672118215, -1.95273558316733, 3.48139850416601, - -0.952297065273875, 1.24738002520415, "", "", "", "", "", 1.70227576368358, - 2.48446501830506, 1.72887724327013, -2.99331507437673, 0.771585871131651, - -1.33482628389656, -0.761717885855758, "", "", "", "", 1.47327037945452, - 0.272709782087463, -1.29757118956179, -2.40643758666971, 0.874896574845907, - -0.503887231903551, 0.376035675353966, -2.1367412250306, "", - "", "", 2.35212346611526, 1.25498978664384, 3.0336022528353, - -1.19107613633585, 2.12597830042835, -2.99704518860994, 2.32847953539758, - -0.590849981828543, 0.804440146444814, "", "", -2.69577565127516, - -2.24649212532572, -1.71719477088287, 0.64413121241335, 1.49678459768851, - -0.987168253316867, 1.96201526731966, 1.27341637632111, -2.11609347217146, - -2.41207540474584, "", 0.623012707174373, 0.275105560993146, - -1.61236921599306, -0.52937530261534, 1.44125542894765, -1.29066565900691, - 2.4993679036409, -2.1413979271183, 0.273074594418328, -0.249446746350577, - -2.59387512655313), "Standardized residual covariance table") +test_that("R-Squared table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_rsquared"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, "x1", 0.883076871616544, 0.88344099961725, 0.883440941017384, + 1, "x2", 0.993698159869737, 0.993307380054294, 0.993308312239004, + 1, "x3", 0.734550879193546, 0.734754000085834, 0.734752992615783, + 1, "y1", 0.76374604003533, 0.78382522538215, 0.783824495338279, + 1, "y2", 0.52698823283752, 0.46980581123522, 0.469797871844076, + 1, "y3", 0.540743668690899, 0.602813004892641, 0.602813008521032, + 1, "y4", 0.758371834315632, 0.715732725592278, 0.715727580943501, + 1, "y5", 0.748735676904241, 0.760689523184986, 0.760685788176715, + 1, "y6", 0.626089440009365, 0.636528021958327, 0.63653017192483, + 1, "y7", 0.729758226751309, 0.710375682244039, 0.710376016894816, + 1, "y8", 0.574575906571732, 0.588831799668115, 0.588835817501575, + 1, "dem60", 0.275927380324135, 0.258157185403395, 0.258145005894785, + 1, "dem65", 0.941713333219214, 0.938883931908498, 0.938882940520488, + 2, "x1", 0.787475869571126, 0.78747617521673, 0.788439850883418, + 2, "x2", 0.90066092940223, 0.900660946749863, 0.900202685338523, + 2, "x3", 0.749867733548725, 0.749868295135394, 0.749372699570641, + 2, "y1", 0.73192194477315, 0.731929437708713, 0.683849857838006, + 2, "y2", 0.550065444500199, 0.550067399151619, 0.519184271086936, + 2, "y3", 0.465824888188388, 0.465819890503162, 0.543696244446078, + 2, "y4", 0.651968126202521, 0.651959003998254, 0.694898810552798, + 2, "y5", 0.536001769615457, 0.535995620432757, 0.598318029638634, + 2, "y6", 0.625808175301569, 0.625823134164411, 0.607599332020874, + 2, "y7", 0.658946836103404, 0.658945492261667, 0.618117097165968, + 2, "y8", 0.842442637402788, 0.842449295416932, 0.821972120799249, + 2, "dem60", 0.075359995596017, 0.0753581296999277, 0.0905522598183016, + 2, "dem65", 0.956917027167473, 0.956910675588687, 0.977886505597789 + )) +}) + +test_that("Mardia's coefficients table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_mardiasTable"]][["data"]] + jaspTools::expect_equal_tables(table, + list(330.897809673901, 26.471824773912, 286, "Skewness", 0.0347860345067629, + "", "", 134.567190822067, "", "Kurtosis", 0.0308358026617142, + -2.15918518879413)) +}) + +# use more constrained model (model 3) +test_that("Residual covariances table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_cov"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-0.69545315422001, 1.13004177555907, 0.21729431066953, 1, "", + "y1 - y5", 0.640785259228911, 0.465696039360507, 0.122229400273519, + 0.21729431066953, 0.466601156771526, 0.433556460847522, 4.21291697813091, + 2.32323671948921, 1, "", "y2 - y4", 0.0159680098210635, 0.964140297243852, + 0.551561502186919, 2.32323671948921, 2.40964590540459, -0.453419237959931, + 2.50595123687697, 1.02626599945852, 1, "", "y2 - y6", 0.174028371605556, + 0.754955320143644, 0.193560311395833, 1.02626599945852, 1.35937316033915, + -0.360831524130952, 2.44595509715677, 1.04256178651291, 1, "", + "y3 - y7", 0.145384170744224, 0.716030152448538, 0.308401783417912, + 1.04256178651291, 1.45603056372383, -1.17525149467719, 0.804530353606657, + -0.185360570535264, 1, "", "y4 - y8", 0.71361142744346, 0.50505567038479, + -0.0554561326806879, -0.185360570535264, -0.367010176113937, + -0.214945884705118, 3.12165697220312, 1.453355543749, 1, "", + "y6 - y8", 0.0877403085918145, 0.851189839003914, 0.345429944586929, + 1.453355543749, 1.70743995892827, -0.11886742207512, 1.57858876509647, + 0.729860671510673, 2, "", "y1 - y5", 0.0918990888281619, 0.433032494617479, + 0.378922580175452, 0.729860671510673, 1.68546397922262, -0.465368071384424, + 3.32132373684632, 1.42797783273095, 2, "", "y2 - y4", 0.139348430266987, + 0.966010558892838, 0.272324473644519, 1.42797783273095, 1.47822176433307, + 0.0620106319572282, 4.11438168211907, 2.08819615703815, 2, "", + "y2 - y6", 0.04338878872498, 1.03378712112223, 0.353104277180307, + 2.08819615703815, 2.01994793161217, -1.37202057656696, 2.36286703932462, + 0.495423231378828, 2, "", "y3 - y7", 0.603085629226233, 0.952794960864562, + 0.102496109909575, 0.495423231378828, 0.519968358070747, -0.467325344620023, + 1.95619519340853, 0.744434924394253, 2, "", "y4 - y8", 0.228555681754256, + 0.618256395817723, 0.289753166031713, 0.744434924394253, 1.20408770443797, + -0.397060222177046, 2.20355649897204, 0.903248138397496, 2, + "", "y6 - y8", 0.173364480031653, 0.663434823716767, 0.311727419658285, + 0.903248138397496, 1.3614723045999)) +}) + +test_that("Factor Loadings table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_ind"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1, 1, 1, 1, "a1", "dem60", "", "y1", 0, 0.88533863314456, 2.42166834174955, + "", 0.760887096093589, 1.3313371657679, 1.04611213093074, 1, + "b1", "dem60", 6.55031584528842e-13, "y2", 0.14552565102572, + 0.685418027078422, 2.53333662939515, 7.18850679283928, 0.783222538721797, + 1.29591955303164, 1.03957104587672, 1, "c1", "dem60", 1.99840144432528e-15, + "y3", 0.130792458012987, 0.776410335145684, 2.51749629079912, + 7.9482491702503, 0.796321916480203, 1.254666698178, 1.0254943073291, + 1, "d1", "dem60", 0, "y4", 0.116926837766704, 0.846006844501568, + 2.48340709870327, 8.77039289624163, 1, 1, 1, 1, "a1", "dem65", + "", "y5", 0, 0.872173026512925, 2.49219827699667, "", 0.76088709609359, + 1.3313371657679, 1.04611213093074, 1, "b1", "dem65", 6.55031584528842e-13, + "y6", 0.14552565102572, 0.79782841007627, 2.60711885025092, + 7.18850679283928, 0.783222538721797, 1.29591955303164, 1.03957104587672, + 1, "c1", "dem65", 1.99840144432528e-15, "y7", 0.130792458012987, + 0.842838072760608, 2.59081716934959, 7.9482491702503, 0.796321916480202, + 1.254666698178, 1.0254943073291, 1, "d1", "dem65", 0, "y8", + 0.116926837766704, 0.767356382329342, 2.55573514579548, 8.77039289624164, + 1, 1, 1, 1, "", "ind60", "", "x1", 0, 0.939915390350315, 0.657997769223972, + "", 1.94762156768505, 2.55197241207619, 2.24979698988062, 1, + "", "ind60", 0, "x2", 0.15417396675607, 0.99664853997736, 1.48036140054826, + 14.5925867850322, 1.40827986384459, 2.2352973910192, 1.82178862743189, + 1, "", "ind60", 0, "x3", 0.210977735738517, 0.857177340237003, + 1.19873285284779, 8.63498046869645, 1, 1, 1, 2, "a2", "dem60", + "", "y1", 0, 0.826952149666476, 1.88731847029564, "", 1.00619302224573, + 1.96819575821982, 1.48719439023278, 2, "b2", "dem60", 1.3615824023816e-09, + "y2", 0.24541337074616, 0.720544426865503, 2.80680944160638, + 6.05995665888569, 0.971906075503644, 1.81486423470427, 1.39338515510396, + 2, "c2", "dem60", 9.20110654334394e-11, "y3", 0.215044298224298, + 0.737357609607495, 2.62976153946346, 6.47952615628345, 1.1349713565327, + 1.96970928417887, 1.55234032035579, 2, "d2", "dem60", 3.10418357685194e-13, + "y4", 0.212947261845238, 0.833605908420039, 2.92976055879213, + 7.28978765401534, 1, 1, 1, 2, "a2", "dem65", "", "y5", 0, 0.773510200087002, + 1.83190459395512, "", 1.00619302224573, 1.96819575821982, 1.48719439023278, + 2, "b2", "dem65", 1.3615824023816e-09, "y6", 0.24541337074616, + 0.77948658232254, 2.7243982355717, 6.05995665888569, 0.971906075503644, + 1.81486423470427, 1.39338515510396, 2, "c2", "dem65", 9.20110654334394e-11, + "y7", 0.215044298224298, 0.78620423374971, 2.55254866678381, + 6.47952615628345, 1.1349713565327, 1.96970928417887, 1.55234032035579, + 2, "d2", "dem65", 3.10418357685194e-13, "y8", 0.212947261845238, + 0.90662678142621, 2.84373936424153, 7.28978765401534, 1, 1, + 1, 2, "", "ind60", "", "x1", 0, 0.887941355542931, 0.569877660945581, + "", 1.83150200846409, 2.8887820741669, 2.3601420413155, 2, "", + "ind60", 0, "x2", 0.269719258629878, 0.94879011658982, 1.3449922260042, + 8.75036529947683, 1.44864109706261, 2.46588646575614, 1.95726378140937, + 2, "", "ind60", 4.61852778244065e-14, "x3", 0.25950613805086, + 0.865663155950766, 1.11540090560308, 7.54226391757168)) +}) + +test_that("Indirect effects table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_indeff"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.481357882786616, 2.46046942401094, 1.47091365339878, 1, "ind60 dem60 dem65", + 0.00357555663623654, 0.504884670543771, 0.388355096619293, 0.388355096619293, + 2.91336564410754, -0.159005756964382, 1.97953264235901, 0.910263442697314, + 2, "ind60 dem60 dem65", 0.0952150456732574, + 0.545555534742452, 0.283169114418044, 0.283169114418044, 1.66850739242712 + )) +}) +test_that("Factor variances table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_lvar"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.209581796157254, 0.656340332450193, "ind60", 0.432961064303724, + 1, "", "ind60", 0.000145359164061221, 0.11397110860631, 1, 1, + 3.79886683211358, 1.81562506860045, 6.88555885899737, "dem60", + 4.35059196379891, 1, "", "dem60", 0.000768902080228617, 1.29337422278876, + 0.741854994105215, 0.741854994105215, 3.3637534188815, -0.373266498808941, + 1.13246899862414, "dem65", 0.379601249907598, 1, "", "dem65", + 0.323041135528457, 0.384123256679747, 0.0611170594795115, 0.0611170594795115, + 0.988227719375192, 0.139438652248964, 0.510082444640648, "ind60", + 0.324760548444806, 2, "", "ind60", 0.000593282653738036, 0.0945537253019125, + 1, 1, 3.43466687756445, 1.18858916628694, 5.29026380193007, + "dem60", 3.2394264841085, 2, "", "dem60", 0.00196225561471941, + 1.04636479751583, 0.909447740181698, 0.909447740181698, 3.09588634078595, + -0.343713422100499, 0.492133643447305, "dem65", 0.0742101106734033, + 2, "", "dem65", 0.727819060325253, 0.213230210386736, 0.0221134944022115, + 0.0221134944022115, 0.348028126684339)) +}) + +test_that("Intercepts table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_mu"]][["data"]] + jaspTools::expect_equal_tables(table, + list(5.11458324908891, 5.5657248590192, 5.34015405405405, 1, "", "x1", + 0, 0.115089260182545, 7.62813069741357, 5.34015405405405, 46.4001075824448, + 4.69962810017026, 5.65682865658649, 5.17822837837838, 1, "", + "x2", 0, 0.244188302429663, 3.48622556023739, 5.17822837837838, + 21.2058822099799, 3.49123572437912, 4.39245184318845, 3.94184378378378, + 1, "", "x3", 0, 0.229906295706965, 2.8186923902073, 3.94184378378378, + 17.1454364555897, 5.06593904030224, 6.82865555429236, 5.9472972972973, + 1, "", "y1", 0, 0.449680843090537, 2.17427463923054, 5.9472972972973, + 13.2255963060892, 2.8433068923927, 5.22515797247216, 4.03423243243243, + 1, "", "y2", 3.1510793974121e-11, 0.607626236723531, 1.0914994882752, + 4.03423243243243, 6.63933218912007, 5.71017508116235, 7.79973464856738, + 6.75495486486486, 1, "", "y3", 0, 0.533060705167854, 2.08326693059751, + 6.75495486486486, 12.6720180260479, 4.36666487548171, 6.25836052992369, + 5.3125127027027, 1, "", "y4", 0, 0.482584289651094, 1.80978064785866, + 5.3125127027027, 11.0084659128535, 4.7688105944112, 6.61024886504826, + 5.68952972972973, 1, "", "y5", 0, 0.469763292887546, 1.99111539784612, + 5.68952972972973, 12.1114821355182, 1.69721605838784, 3.80307150917973, + 2.75014378378378, 1, "", "y6", 3.0678012175045e-07, 0.537217894666077, + 0.841596785005096, 2.75014378378378, 5.11923338944845, 5.40096255495844, + 7.38189582341994, 6.39142918918919, 1, "", "y7", 0, 0.505349405419397, + 2.07924353896206, 6.39142918918919, 12.6475446901631, 3.28677224232023, + 5.43309959551761, 4.35993591891892, 1, "", "y8", 1.77635683940025e-15, + 0.547542549283389, 1.30906547943098, 4.35993591891892, 7.96273444798967, + 0, 0, 0, 1, "", "ind60", "", 0, 0, 0, "", 0, 0, 0, 1, "", "dem60", + "", 0, 0, 0, "", 0, 0, 0, 1, "", "dem65", "", 0, 0, 0, "", 4.57207725542128, + 4.98019327089451, 4.77613526315789, 2, "", "x1", 0, 0.104113141540458, + 7.44182183380898, 4.77613526315789, 45.8744707199323, 3.96560094944745, + 4.86703905055255, 4.41632, 2, "", "x2", 0, 0.229962924884214, + 3.11537917222494, 4.41632, 19.2044869938213, 2.77397157389088, + 3.5933194787407, 3.18364552631579, 2, "", "x3", 0, 0.209021163478697, + 2.47082875752998, 3.18364552631579, 15.2312113918563, 4.26909702968856, + 5.72037665452197, 4.99473684210526, 2, "", "y1", 0, 0.370231197175285, + 2.18850630331101, 4.99473684210526, 13.4908589017163, 3.23427002973367, + 5.71134102289791, 4.47280552631579, 2, "", "y2", 1.46083145580178e-12, + 0.631917477235055, 1.14822725286102, 4.47280552631579, 7.07814815612709, + 5.24236503773366, 7.51026812016108, 6.37631657894737, 2, "", + "y3", 0, 0.578557335827686, 1.78785242699706, 6.37631657894737, + 11.0210625362228, 2.49773616542884, 4.73263378193958, 3.61518497368421, + 2, "", "y4", 2.28425278692157e-10, 0.570137419396307, 1.02862998310584, + 3.61518497368421, 6.34090107173139, 3.8445374644968, 5.35053095655583, + 4.59753421052632, 2, "", "y5", 0, 0.384189072844736, 1.94127992190524, + 4.59753421052632, 11.9668531342752, 2.08873924651352, 4.31127233243385, + 3.20000578947368, 2, "", "y6", 1.66224263242754e-08, 0.566983144448415, + 0.915564231279042, 3.20000578947368, 5.64391696791407, 4.97396373438813, + 7.03851152876977, 6.00623763157895, 2, "", "y7", 0, 0.526680033578813, + 1.84996647323635, 6.00623763157895, 11.4039592326413, 2.73789322525069, + 4.73245519580195, 3.73517421052632, 2, "", "y8", 2.1227464230833e-13, + 0.508826179022704, 1.19082958696493, 3.73517421052632, 7.34076658103641, + 0, 0, 0, 2, "", "ind60", "", 0, 0, 0, "", 0, 0, 0, 2, "", "dem60", + "", 0, 0, 0, "", 0, 0, 0, 2, "", "dem65", "", 0, 0, 0, "")) +}) + +test_that("Regression coefficients table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_reg"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.721100887385484, 3.01873119149589, 1.86991603944068, 1, "dem60", + 0.00142166660030707, "ind60", 0.586140950097506, 0.508079723955586, + 0.508079723955586, 3.19021566251192, 0.478026990501647, 1.96570674995583, + 1.22186687022874, 1, "dem65", 0.00128400773281556, "ind60", + 0.379517116433978, 0.322601007439931, 0.322601007439931, 3.21953033820887, + 0.57221880758124, 1.00102151163518, 0.786620159608207, 1, "dem65", + 6.43485265072741e-13, "dem60", 0.109390454986999, 0.764358580570402, + 0.764358580570402, 7.19093964552664, -0.154169499850175, 2.14733425618151, + 0.996582378165669, 2, "dem60", 0.0896244560519976, "ind60", + 0.587129093745002, 0.300919025351176, 0.300919025351176, 1.69738203877612, + -0.115343312911727, 0.965518339190619, 0.425087513139446, 2, + "dem65", 0.123158203529764, "ind60", 0.275735079988215, 0.132238260924966, + 0.132238260924966, 1.54165191152905, 0.730849486045174, 1.0959206087116, + 0.913385047378385, 2, "dem65", 0, "dem60", 0.0931320997595, + 0.941014327982693, 0.941014327982693, 9.80741387488384)) +}) + +test_that("Total effects table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_toteff"]][["data"]] + jaspTools::expect_equal_tables(table, + list(1.63130176674445, 3.75425928051059, 2.69278052362752, 1, " ind60 dem65", + 6.62397930284442e-07, 0.541580746001396, 0.710956104059224, + 0.710956104059224, 4.9720758049633, 0.721100887385484, 3.01873119149589, + 1.86991603944068, 1, " ind60 dem60", 0.00142166660030707, + 0.586140950097506, 0.508079723955586, 0.508079723955586, 3.19021566251192, + 0.57221880758124, 1.00102151163518, 0.786620159608207, 1, " dem60 dem65", + 6.43485265072741e-13, 0.109390454986999, 0.764358580570402, + 0.764358580570402, 7.19093964552664, 0.247077278791199, 2.42362463288232, + 1.33535095583676, 2, " ind60 dem65", 0.0161748412862073, + 0.555251874845521, 0.41540737534301, 0.41540737534301, 2.40494632495978, + -0.154169499850175, 2.14733425618151, 0.996582378165669, 2, + " ind60 dem60", 0.0896244560519976, 0.587129093745002, + 0.300919025351176, 0.300919025351176, 1.69738203877612, 0.730849486045174, + 1.0959206087116, 0.913385047378385, 2, " dem60 dem65", + 0, 0.0931320997595, 0.941014327982693, 0.941014327982693, 9.80741387488384 + )) +}) + +test_that("Residual variances table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_params"]][["collection"]][["modelContainer_params_more constrained"]][["collection"]][["modelContainer_params_more constrained_var"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.01997186252367, 0.0942758067619235, "x1", 0.0571238346427967, + 1, "", "x1", 0.00258179957955318, 0.018955436126468, 0.116559058982616, + 0.0571238346427967, 3.01358587909423, -0.11906689502126, 0.14859374377243, + "x2", 0.0147634243755852, 1, "", "x2", 0.828822156218448, 0.0682820299007949, + 0.00669168776099586, 0.0147634243755852, 0.216212441209417, + 0.265760017116717, 0.771730033511778, "x3", 0.518745025314248, + 1, "", "x3", 5.84703635451156e-05, 0.129076355582574, 0.265247007384217, + 0.518745025314248, 4.01890046378317, 0.416929012723992, 2.8178675599656, + "y1", 1.6173982863448, 1, "", "y1", 0.00827424337844862, 0.6124955780259, + 0.216175504661721, 1.6173982863448, 2.64066932786314, 3.6422943641347, + 10.8436303032503, "y2", 7.2429623336925, 1, "", "y2", 8.06075272525852e-05, + 1.83710925198596, 0.530202128155924, 7.2429623336925, 3.94258660766238, + 1.93231536174241, 6.4194844290427, "y3", 4.17589989539255, 1, + "", "y3", 0.000264281837194957, 1.14470702081633, 0.397186991478968, + 4.17589989539255, 3.64800758574416, 0.93173773052758, 3.96732278342862, + "y4", 2.4495302569781, 1, "", "y4", 0.00156076961142482, 0.774398171814725, + 0.284272419056499, 2.4495302569781, 3.16314054724312, 0.731947613473432, + 3.17608668229298, "y5", 1.95401714788321, 1, "", "y5", 0.00172519104088487, + 0.623516321753513, 0.239314211823285, 1.95401714788321, 3.1338668767931, + 1.83678103920145, 5.92570847199075, "y6", 3.8812447555961, 1, + "", "y6", 0.000198569846390884, 1.04311290029874, 0.36346982807517, + 3.8812447555961, 3.72082902482037, 1.19521510119158, 4.27809128408789, + "y7", 2.73665319263973, 1, "", "y7", 0.000501976062955212, 0.786462457273105, + 0.289623983105184, 2.73665319263973, 3.47969972035094, 2.19176630693914, + 6.93007982455805, "y8", 4.5609230657486, 1, "", "y8", 0.000161182628549028, + 1.20877565990858, 0.411164182498425, 4.5609230657486, 3.7731757984716, + 0.0313581547372396, 0.142926262721323, "x1", 0.0871422087292811, + 2, "", "x1", 0.00220063448354768, 0.028461775028551, 0.211560149116582, + 0.0871422087292811, 3.06172783116533, -0.0362625145248565, 0.437358296920386, + "x2", 0.200547891197765, 2, "", "x2", 0.0969472731767398, 0.120823855739468, + 0.0997973146614766, 0.200547891197765, 1.65983687551078, 0.174335809406036, + 0.657854185584765, "x3", 0.4160949974954, 2, "", "x3", 0.000742674694836687, + 0.123348791098372, 0.250627300429359, 0.4160949974954, 3.37332043378973, + 0.677289432337447, 2.61617514252464, "y1", 1.64673228743104, + 2, "", "y1", 0.000870742833370297, 0.49462279038821, 0.316150142161994, + 1.64673228743104, 3.3292689286286, 3.61992130179098, 10.9720172658966, + "y2", 7.29596928384381, 2, "", "y2", 0.000100243055731752, 1.87556914874407, + 0.480815728913064, 7.29596928384381, 3.89000282326534, 2.80111563779993, + 8.80696575716, "y3", 5.80404069747997, 2, "", "y3", 0.000151736573070327, + 1.53213277558502, 0.456303755553922, 5.80404069747997, 3.78820999718107, + 1.47037447709157, 6.06693911088752, "y4", 3.76865679398954, + 2, "", "y4", 0.00130948831028244, 1.17261456589332, 0.305101189447202, + 3.76865679398954, 3.21389218896365, 1.06639719058275, 3.43954844740018, + "y5", 2.25297281899147, 2, "", "y5", 0.000198106085773198, 0.605406853272955, + 0.401681970361366, 2.25297281899147, 3.72141941706049, 2.22486686950904, + 7.36215298125324, "y6", 4.79350992538114, 2, "", "y6", 0.000254573265779712, + 1.31055625314201, 0.392400667979126, 4.79350992538114, 3.65761478295103, + 1.879286741696, 6.17148505626852, "y7", 4.02538589898226, 2, + "", "y7", 0.000236681377468129, 1.09496866994211, 0.381882902834032, + 4.02538589898226, 3.67625669070064, 0.346950686712702, 3.15605228468597, + "y8", 1.75150148569934, 2, "", "y8", 0.0145209073086161, 0.716620718577256, + 0.178027879200751, 1.75150148569934, 2.44411226230897)) +}) + + +# default model covariance tables check for group 1 +test_that("1 table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][["modelContainer_covars_default"]][["collection"]][["modelContainer_covars_default_implied"]][["collection"]][["modelContainer_covars_default_implied_1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.490083005636341, "", "", "", "", "", "", "", "", "", "", 0.974061924820938, + 2.20622852804643, "", "", "", "", "", "", "", "", "", 0.788491080043325, + 1.77466015582184, 1.95570584174645, "", "", "", "", "", "", + "", "", 0.835178540092756, 1.8797398164842, 1.52162613108251, + 7.64797977172546, "", "", "", "", "", "", "", 0.9556665272501, + 2.15092263069126, 1.74114526494314, 6.68378929397842, 14.5127221504755, + "", "", "", "", "", "", 0.788253740427642, 1.77412597456094, + 1.43613303237535, 5.51292920802482, 6.30825824454684, 9.62227326013949, + "", "", "", "", "", 0.904244744111687, 2.03518740934666, 1.64745903478501, + 6.32415300473141, 9.23882105681506, 5.96882824654786, 9.02873362112342, + "", "", "", "", 1.14334478995369, 2.57333087773905, 2.08307951619226, + 5.82366205597871, 6.32427984118542, 5.21639829184989, 5.98398776520799, + 7.98119516009608, "", "", "", 1.18710886159188, 2.67183085593611, + 2.1628140302039, 5.73848644656919, 7.58931007411125, 5.41606756969488, + 6.21303824196685, 6.20454284533334, 10.2893215377554, "", "", + 1.25970543427748, 2.83522426425122, 2.29507897323412, 6.08941841405952, + 6.96791532513606, 6.91162808862571, 6.59299099686961, 6.58397607191047, + 6.83599243915777, 9.94033521063152, "", 1.15531617741013, 2.60027492931626, + 2.10489039267505, 5.58480055205704, 6.39049819021455, 5.27101657115424, + 5.85298682041024, 6.03837521104467, 7.68811256412373, 6.65291356937699, + 10.6193105678442)) +}) + +test_that("1 table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][["modelContainer_covars_default"]][["collection"]][["modelContainer_covars_default_observed"]][["collection"]][["modelContainer_covars_default_observed_1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.490082575997078, "", "", "", "", "", "", "", "", "", "", 0.973932449184952, + 2.20622591129467, "", "", "", "", "", "", "", "", "", 0.78518275394412, + 1.77565205254938, 1.95570361423433, "", "", "", "", "", "", + "", "", 0.842173686632578, 1.60646357669832, 1.14904644265887, + 7.62580350620892, "", "", "", "", "", "", "", 0.966640855417165, + 2.56661076528232, 2.30600417597728, 6.02486581738495, 14.676007521986, + "", "", "", "", "", "", 0.569651258731629, 1.29778304025924, + 0.7519816050897, 6.44636651314828, 5.79397804058276, 9.73209047934931, + "", "", "", "", "", 1.07850808055391, 2.50663181045844, 2.0195628491114, + 6.09461043973703, 9.30788611653126, 5.64475186161118, 9.01279131583053, + "", "", "", "", 1.23810412812272, 2.61063748721578, 1.81722127066318, + 5.59878435062089, 6.6520705502466, 5.03859665459321, 6.05661431962235, + 7.93189524242966, "", "", "", 1.43792308816034, 2.91763544604397, + 2.84145873393433, 5.38621551022644, 8.42865402090701, 4.21966332811403, + 6.90922843998977, 6.08535469304967, 10.3746040258343, "", "", + 1.04665319855464, 2.45836864046896, 1.77472198140307, 6.2463340788897, + 7.67698969559927, 6.7341948942526, 7.01801387855084, 6.81611022694302, + 6.30443702471928, 9.78003437719123, "", 1.23565159843141, 2.65937421505933, + 1.72765599854139, 5.4174694403214, 7.39753077439182, 4.59181056574472, + 6.45111697395995, 5.63862367744565, 7.72100725388949, 6.57011319209561, + 10.545706988345)) +}) + + +test_that("1 table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][["modelContainer_covars_default"]][["collection"]][["modelContainer_covars_default_residual"]][["collection"]][["modelContainer_covars_default_residual_1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-4.29639262722326e-07, "", "", "", "", "", "", "", "", "", "", + -0.000129475635985754, -2.6167517583886e-06, "", "", "", "", + "", "", "", "", "", -0.00330832609920539, 0.000991896727537744, + -2.22751211897965e-06, "", "", "", "", "", "", "", "", 0.00699514653982192, + -0.27327623978588, -0.372579688423637, -0.0221762655165412, + "", "", "", "", "", "", "", 0.0109743281670655, 0.415688134591064, + 0.56485891103414, -0.658923476593472, 0.16328537151047, "", + "", "", "", "", "", -0.218602481696013, -0.476342934301694, + -0.684151427285654, 0.933437305123464, -0.514280203964078, 0.10981721920982, + "", "", "", "", "", 0.17426333644222, 0.471444401111772, 0.37210381432639, + -0.229542564994381, 0.0690650597162001, -0.324076384936683, + -0.0159423052928904, "", "", "", "", 0.0947593381690282, 0.0373066094767256, + -0.265858245529077, -0.224877705357818, 0.327790709061186, -0.177801637256686, + 0.0726265544143585, -0.0492999176664268, "", "", "", 0.250814226568451, + 0.245804590107868, 0.67864470373043, -0.352270936342745, 0.83934394679576, + -1.19640424158085, 0.696190198022921, -0.119188152283667, 0.0852824880789473, + "", "", -0.213052235722839, -0.376855623782266, -0.520356991831051, + 0.156915664830179, 0.709074370463213, -0.17743319437311, 0.425022881681229, + 0.232134155032551, -0.53155541443849, -0.16030083344029, "", + 0.0803354210212781, 0.0590992857430699, -0.37723439413366, -0.16733111173564, + 1.00703258417727, -0.67920600540952, 0.598130153549713, -0.399751533599017, + 0.0328946897657652, -0.0828003772813819, -0.073603579499224 + )) +}) + +test_that("1 table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_covars"]][["collection"]][["modelContainer_covars_default"]][["collection"]][["modelContainer_covars_default_stdres"]][["collection"]][["modelContainer_covars_default_stdres_1"]][["data"]] + jaspTools::expect_equal_tables(table, + list(-4.29639262722326e-07, "", "", "", "", "", "", "", "", "", "", + -0.9060620509028, -2.6167517583886e-06, "", "", "", "", "", + "", "", "", "", -0.386009809456628, 1.26765266846776, -2.22751211897965e-06, + "", "", "", "", "", "", "", "", 0.0846242017037104, -1.78626926801871, + -1.50899731338325, -0.979353662951696, "", "", "", "", "", "", + "", 0.0462187188848004, 0.91510411685768, 1.26724625016894, + -3.1061390877585, 1.19239959132506, "", "", "", "", "", "", + -1.56053141398549, -1.9857167211822, -1.9527355831674, 3.4813985041659, + -0.952297065273916, 1.24738002520413, "", "", "", "", "", 1.70227576368341, + 2.48446501830487, 1.72887724327009, -2.99331507437673, 0.771585871131433, + -1.33482628389661, -0.761717885856068, "", "", "", "", 1.47327037945439, + 0.272709782087367, -1.29757118956185, -2.40643758667, 0.874896574845803, + -0.503887231903609, 0.37603567535386, -2.13674122503159, "", + "", "", 2.35212346611509, 1.25498978664378, 3.03360225283525, + -1.19107613633595, 2.12597830042828, -2.99704518860994, 2.32847953539746, + -0.590849981828658, 0.80444014644474, "", "", -2.69577565127534, + -2.24649212532582, -1.71719477088293, 0.644131212413233, 1.49678459768839, + -0.98716825331695, 1.96201526731965, 1.27341637632093, -2.11609347217155, + -2.41207540474613, "", 0.623012707174326, 0.275105560993087, + -1.61236921599312, -0.529375302615407, 1.4412554289476, -1.29066565900695, + 2.49936790364071, -2.14139792711848, 0.273074594418215, -0.249446746350653, + -2.59387512655443)) }) @@ -705,7 +719,7 @@ test_that("t-size RMSEA and CFI match values of original article (Katerina M. Ma options$group <- "" options$dataType <- "varianceCovariance" options$models <- list(list(name = "Model1", syntax = list(model = "factor1 =~ V1 + V2 + V3 + V4 + V5 + V6 + V7\n factor2 =~ V8 + V9 + V10 + V11 + V12", - columns = c("V1", "V2", "V3", "V4", "V5", "V6", "V7", "V8", "V9", "V10", "V11", "V12")))) + columns = c("V1", "V2", "V3", "V4", "V5", "V6", "V7", "V8", "V9", "V10", "V11", "V12")))) set.seed(1) dataset <- structure(list(V1 = c(1.321, 0.443, 0.283, 0.379, 0.462, 0.316, 0.392, 0.404, 0.398, 0.313, 0.374, 0.381), V2 = c(0.443, 1.41, 0.507, 0.526, 0.466, 0.392, 0.404, 0.342, 0.493, 0.423, 0.448, 0.486), @@ -766,7 +780,7 @@ test_that("Variance-covariance input works", { options$models <- list( list(name = "Model1", syntax = list(model = "F =~ x1 + x3 + y1", columns = c("x1", "x2", "x3"))), list(name = "Model2", syntax = list(model = "F =~ y1 + y2 + y3", columns = c("y1", "y2", "y3"))) - ) + ) data <- read.csv("poldem_grouped.csv") # data <- read.csv("tests/testthat/poldem_grouped.csv") @@ -1026,3 +1040,66 @@ test_that("Residual variances table results match", { 2, "", "y8", 0.0126047867836248, 0.586172227118478, 2.494744461643 )) }) + + +# Sensitivity analysis works +options <- analysisOptions("SEM") +options$samplingWeights <- "" +options$sensitivityAnalysis <- TRUE +options$sizeOfSolutionArchive <- 10 +options$maxIterations <- 10 +options$informationMatrix <- "expected" +options$estimator <- "default" +options$modelTest <- "standard" +options$emulation <- "lavaan" +options$group <- "" +options$setSeed <- TRUE +options$seed <- 1 +model <- " +# latent variable definitions +ind60 =~ x1 + x2 + x3 +dem60 =~ y1 + y2 + y3 + y4 +dem65 =~ y5 + y6 + y7 + y8 +# regressions +dem60 ~ ind60 +dem65 ~ ind60 + dem60 +# residual (co)variances +y1 ~~ y5 +y2 ~~ y4 + y6 +y3 ~~ y7 +y4 ~~ y8 +y6 ~~ y8 +" +options$models <- list(list(name = "Model1", + syntax = list(model=model, + columns = c("x1", "x2", "x3", "y1", "y2", "y3", "y4", "y5", "y6", "y7", "y8")))) +set.seed(1) +results <- runAnalysis("SEM", "poldem_grouped.csv", options) + +test_that("Sensitivity parameters that led to a change in significance table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_sensitivity"]][["collection"]][["modelContainer_sensitivity_senpar"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.163825629932947, -0.00736627172133829, 1.83420695785249, "dem60~ind60", + 0.136451103548822, -0.356128009622868, -0.859719801919833, "dem65~ind60" + )) +}) + +test_that("Summary of sensitivity analysis table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_sensitivity"]][["collection"]][["modelContainer_sensitivity_sensum"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.446712905437343, 0.773905343716094, 0.379067079696325, -0.0960469939853047, + "dem60~ind60", 1.54185576191068e-05, 0.243857952730406, 0.885228943292037, + 1.20492628703677, 0.894340089736308, 0.770806763710209, "dem65~dem60", + 0, "", 0.182259409976201, 0.380588637180451, 0.0646300844286729, + -0.56059414912222, "dem65~ind60", 0.00967602063729744, 0.125746802403301 + )) +}) + +test_that("Summary of sensitivity parameters table results match", { + table <- results[["results"]][["modelContainer"]][["collection"]][["modelContainer_sensitivity"]][["collection"]][["modelContainer_sensitivity_sensumpar"]][["data"]] + jaspTools::expect_equal_tables(table, + list(0.332587428764211, 0.0594414507904125, -0.268377141254013, "dem60~phantom", + 0.467843048994546, 0.0319319696951054, -0.462805738408711, "dem65~phantom", + 2.16041463170958, 0.508721525156672, -1.30877622339889, "ind60~phantom" + )) +})