diff --git a/DESCRIPTION b/DESCRIPTION index 727a06b..36d2d91 100755 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: metaSEM Type: Package Title: Meta-Analysis using Structural Equation Modeling -Version: 1.3.1 -Date: 2023-08-08 +Version: 1.4.0 +Date: 2024-04-08 Depends: R (>= 3.4.0), OpenMx Imports: Matrix, MASS, ellipse, graphics, stats, utils, mvtnorm, numDeriv, lavaan Suggests: metafor, semPlot, R.rsp, testthat, matrixcalc diff --git a/NAMESPACE b/NAMESPACE index 9f55ba8..ae5b1dc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -14,6 +14,7 @@ S3method(plot, meta) S3method(plot, character) S3method(plot, wls) S3method(plot, osmasem) +S3method(plot, mxRAMmodel) # S3method(plot, osmasem3L) S3method(summary, wls) @@ -28,6 +29,7 @@ S3method(summary, CorPop) S3method(summary, Cor3L) S3method(summary, bootuniR2) S3method(summary, osmasem) +S3method(summary, mxRAMmodel) # S3method(summary, osmasem3L) # S3method(summary, tssemRobust1) @@ -36,6 +38,7 @@ S3method(anova, meta3LFIML) S3method(anova, wls) S3method(anova, reml) S3method(anova, osmasem) +S3method(anova, mxRAMmodel) # S3method(anova, osmasem3L) S3method(coef, tssem1FEM) @@ -46,8 +49,8 @@ S3method(coef, tssem1REM) S3method(coef, meta) S3method(coef, meta3LFIML) S3method(coef, reml) -S3method(coef, MxRAMModel) S3method(coef, osmasem) +S3method(coef, mxRAMmodel) # S3method(coef, osmasem3L) # S3method(coef, tssemRobust1) @@ -59,8 +62,8 @@ S3method(vcov, tssem1REM) S3method(vcov, meta) S3method(vcov, meta3LFIML) S3method(vcov, reml) -S3method(vcov, MxRAMModel) S3method(vcov, osmasem) +S3method(vcov, mxRAMmodel) # S3method(vcov, osmasem3L) # S3method(vcov, tssemRobust1) @@ -81,6 +84,7 @@ S3method(print, uniR1) S3method(print, summary.CorPop) S3method(print, summary.Cor3L) S3method(print, summary.bootuniR2) +S3method(print, summary.mxRAMmodel) # required by R3.3 importFrom("graphics", "abline", "arrows", "layout", "par", "plot", diff --git a/NEWS b/NEWS index 9ef2c52..ef3b89c 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,8 @@ +Release 1.4.0 (Apr 8, 2024) +==================================== +* Revise create.mxModel(). +* Replace dontrun with donttest. + Release 1.3.1 (Aug 8, 2023) ==================================== * Lower the tolerance in testing asyCov(), which returns an error in latest R. diff --git a/R/as.mxMatrix.R b/R/as.mxMatrix.R index 2107bd0..9a5c7c2 100644 --- a/R/as.mxMatrix.R +++ b/R/as.mxMatrix.R @@ -72,14 +72,16 @@ as.mxMatrix <- function(x, name, ...) { } as.symMatrix <- function(x) { - if (is.list(x)) { - for (i in seq_along(x)) { - x[[i]][] <- vapply(x[[i]], function(z) gsub(".*\\*", "", z), character(1)) - } - } else { - x[] <- vapply(x, function(z) gsub(".*\\*", "", z), character(1)) + if (is.list(x)) { + ## for (i in seq_along(x)) { + ## Exclude mxalgebras, which creates troubles + for (i in c("A", "S", "F", "M")) { + x[[i]][] <- vapply(x[[i]], function(z) gsub(".*\\*", "", z), character(1)) } - x + } else { + x[] <- vapply(x, function(z) gsub(".*\\*", "", z), character(1)) + } + x } as.mxAlgebra <- function(x, startvalues=NULL, name="X") { diff --git a/R/create.mxModel.R b/R/create.mxModel.R index 5e8c820..67a55e5 100644 --- a/R/create.mxModel.R +++ b/R/create.mxModel.R @@ -1,179 +1,402 @@ +## FIXME: when there are constraints with replace.constraints=TRUE and +## intervals.type="LB", it returns an error because some parameters are +## replaced with the new parameters in the constraints. However, the +## names of these new parameters are not in the CI object. create.mxModel <- function(model.name="mxModel", RAM=NULL, data=NULL, Cov=NULL, means=NULL, numObs, - intervals.type = c("z", "LB"), startvalues=NULL, - mxModel.Args=NULL, run=TRUE, mxTryHard=FALSE, - silent=TRUE, ...) { - - intervals.type <- match.arg(intervals.type) - switch(intervals.type, - z = intervals <- FALSE, - LB = intervals <- TRUE) - - Amatrix <- as.mxMatrix(RAM$A, name="Amatrix") - Smatrix <- as.mxMatrix(RAM$S, name="Smatrix") - Fmatrix <- as.mxMatrix(RAM$F, name="Fmatrix") - Mmatrix <- as.mxMatrix(RAM$M, name="Mmatrix") - - ## Some basic checking in RAM - checkRAM(Amatrix, Smatrix, cor.analysis=FALSE) - - ## Extract the dimnames from Fmatrix$values - var.names <- colnames(Fmatrix$values) - - ## Without raw data - if (is.null(data)) { - ## Without means - if (is.null(means)) { - mx.data <- mxData(observed=Cov, type="cov", numObs=numObs) - expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", - F="Fmatrix", dimnames=var.names) - } else { - ## With means - mx.data <- mxData(observed=Cov, type="cov", means=means, numObs=numObs) - expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", F="Fmatrix", - M="Mmatrix", dimnames=var.names) - } - } else { - ## With raw data - mx.data <- mxData(observed=data, type="raw") - expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", F="Fmatrix", - M="Mmatrix", dimnames=var.names) - } - - ## Create an incomplete model, which will be used to store other mx objects. - mx.model <- mxModel(model.name, mx.data, expFun, mxFitFunctionML()) - - ## Collate the starting values from RAM and add them to startvalues - para.labels <- c(Amatrix$labels[Amatrix$free], Smatrix$labels[Smatrix$free], - Mmatrix$labels[Mmatrix$free]) - para.values <- c(Amatrix$values[Amatrix$free], Smatrix$values[Smatrix$free], - Mmatrix$values[Mmatrix$free]) - names(para.values) <- para.labels - para.values <- as.list(para.values) - ## Remove starting values from para.values if they are overlapped with startvalues - para.values[names(para.values) %in% names(startvalues)] <- NULL - startvalues <- c(startvalues, para.values) - - ## Extract a local copy for ease of reference - ## Remove starting values for ease of matching - A <- as.symMatrix(RAM$A) - S <- as.symMatrix(RAM$S) - M <- as.symMatrix(RAM$M) - mxalgebras <- RAM$mxalgebras + intervals.type=c("z", "LB"), startvalues=NULL, + replace.constraints=FALSE, mxModel.Args=NULL, + run=TRUE, silent=TRUE, ...) { + + intervals.type <- match.arg(intervals.type) - ## Any names of the constraints == parameters? - ## If yes, these parameters are replaced by the constraints - index <- sapply(mxalgebras, function(x) { - ## Convert R language to a vector string - ## form[1]: "==" - ## form[2]: "m" - ## form[3]: "p1 * cos(p2 * data.x) + p2 * sin(p1 * data.x)" - form <- as.character(x$formula) - if (form[1]=="==" & form[2]%in% para.labels) TRUE else FALSE - }) + Amatrix <- as.mxMatrix(RAM$A, name="Amatrix") + Smatrix <- as.mxMatrix(RAM$S, name="Smatrix") + Fmatrix <- as.mxMatrix(RAM$F, name="Fmatrix") + Mmatrix <- as.mxMatrix(RAM$M, name="Mmatrix") - ############################################# - ## Need to replace parameters with mxalgebras, if any TRUE - if (any(index)) { - - ## Extract constraints that needed to be replaced - mxalgebras.const <- mxalgebras[index] - - for (i in seq_along(mxalgebras.const)) { - form <- as.character(mxalgebras.const[[i]]$formula) - - ## Replace the A matrix - if (any(grep(form[2], A))) { - A[which(form[2]==A)] <- form[3] - } - - ## Replace the S matrix - if (any(grep(form[2], S))) { - S[which(form[2]==S)] <- form[3] - } - - ## Replace the M matrix - if (any(grep(form[2], M))) { - M[which(form[2]==M)] <- form[3] - } - } - - ## Remove the constraints so they won't be added again - mxalgebras[index] <- NULL - } + ## Some basic checking in RAM + checkRAM(Amatrix, Smatrix, cor.analysis=FALSE) - ## Check whether there are replacements - ## Remove the starting values before comparisons - if (all(A==as.symMatrix(RAM$A))) { - mx.model <- mxModel(mx.model, Amatrix) + ## Extract all observed and latent variable names + var.names <- colnames(Fmatrix$values) + + ## Without raw data + if (is.null(data)) { + ## Without means + if (is.null(means)) { + mx.data <- mxData(observed=Cov, type="cov", numObs=numObs) + expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", + F="Fmatrix", dimnames=var.names) } else { - A <- as.mxAlgebra(A, startvalues=startvalues, name="Amatrix") - mx.model <- mxModel(mx.model, A$mxalgebra, A$parameters, A$list) + ## With means + mx.data <- mxData(observed=Cov, type="cov", means=means, numObs=numObs) + expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", F="Fmatrix", + M="Mmatrix", dimnames=var.names) } + } else { + ## With raw data + mx.data <- mxData(observed=data, type="raw") + expFun <- mxExpectationRAM(A="Amatrix", S="Smatrix", F="Fmatrix", + M="Mmatrix", dimnames=var.names) + } - if (all(S==as.symMatrix(RAM$S))) { - mx.model <- mxModel(mx.model, Smatrix) - } else { - S <- as.mxAlgebra(S, startvalues=startvalues, name="Smatrix") - mx.model <- mxModel(mx.model, S$mxalgebra, S$parameters, S$list) + ## Create an incomplete model, which will be used to store other mx objects. + mx.model <- mxModel(model.name, mx.data, expFun, mxFitFunctionML()) + + ## Collate the starting values from RAM and add them to startvalues + para.labels <- c(Amatrix$labels[Amatrix$free], Smatrix$labels[Smatrix$free], + Mmatrix$labels[Mmatrix$free]) + para.values <- c(Amatrix$values[Amatrix$free], Smatrix$values[Smatrix$free], + Mmatrix$values[Mmatrix$free]) + ## Name the starting values with names, which is consistent with the startvalues + names(para.values) <- para.labels + para.values <- as.list(para.values) + ## Remove starting values from para.values if they are overlapped with startvalues + para.values[names(para.values) %in% names(startvalues)] <- NULL + startvalues <- c(startvalues, para.values) + + ## Extract a local copy for ease of reference + ## Remove starting values for ease of matching + A <- as.symMatrix(RAM$A) + S <- as.symMatrix(RAM$S) + M <- as.symMatrix(RAM$M) + mxalgebras <- RAM$mxalgebras + + ## Any names of the constraints == parameters? + ## If yes, these parameters are replaced by the constraints + index <- sapply(mxalgebras, function(x) { + ## Convert R language to a vector string + ## form[1]: "==" + ## form[2]: "m" + ## form[3]: "p1 * cos(p2 * data.x) + p2 * sin(p1 * data.x)" + form <- as.character(x$formula) + if (form[1]=="==" & form[2]%in% para.labels) TRUE else FALSE + }) + + ############################################# + ## Need to replace parameters with mxalgebras, + ## if any TRUE and replace.constraints==TRUE + if (any(index) & replace.constraints) { + + ## Extract constraints that needed to be replaced + mxalgebras.const <- mxalgebras[index] + + for (i in seq_along(mxalgebras.const)) { + form <- as.character(mxalgebras.const[[i]]$formula) + + ## Replace the A matrix + if (any(grep(form[2], A))) { + A[which(form[2]==A)] <- form[3] + } + + ## Replace the S matrix + if (any(grep(form[2], S))) { + S[which(form[2]==S)] <- form[3] + } + + ## Replace the M matrix + if (any(grep(form[2], M))) { + M[which(form[2]==M)] <- form[3] + } } + + ## Remove the constraints so they won't be added again + mxalgebras[index] <- NULL + } + + ## Check whether there are replacements + ## Remove the starting values before comparisons + if (all(A==as.symMatrix(RAM$A))) { + mx.model <- mxModel(mx.model, Amatrix) + } else { + A <- as.mxAlgebra(A, startvalues=startvalues, name="Amatrix") + mx.model <- mxModel(mx.model, A$mxalgebra, A$parameters, A$list) + } + + if (all(S==as.symMatrix(RAM$S))) { + mx.model <- mxModel(mx.model, Smatrix) + } else { + S <- as.mxAlgebra(S, startvalues=startvalues, name="Smatrix") + mx.model <- mxModel(mx.model, S$mxalgebra, S$parameters, S$list) + } - ## Create an identity matrix from the no. of columens of Fmatrix, - ## including all latent and observed variables - Id <- as.mxMatrix(diag(ncol(Fmatrix$values)), name="Id") + ## Create an identity matrix from the no. of columens of Fmatrix, + ## including all latent and observed variables + Id <- as.mxMatrix(diag(ncol(Fmatrix$values)), name="Id") - ## Expected covariance matrix and means of the observed and latent variables - Id_A <- mxAlgebra(solve(Id - Amatrix), name="Id_A") - expCov <- mxAlgebra(Id_A %&% Smatrix, name="expCov") + ## Expected covariance matrix and means of the observed and latent variables + Id_A <- mxAlgebra(solve(Id - Amatrix), name="Id_A") + expCov <- mxAlgebra(Id_A %&% Smatrix, name="expCov") - ## Add the mean structure only if there are means - if (!is.null(data) | !is.null(means)) { - - if (all(M==as.symMatrix(RAM$M))) { - mx.model <- mxModel(mx.model, Mmatrix) - } else { - M <- as.mxAlgebra(M, startvalues=startvalues, name="Mmatrix") - mx.model <- mxModel(mx.model, M$mxalgebra, M$parameters, M$list) - } - - expMean <- mxAlgebra(Mmatrix %*% t(Id_A), name="expMean") - mx.model <- mxModel(mx.model, Fmatrix, Id, Id_A, expCov, expMean, - mxCI(c("Amatrix", "Smatrix", "Mmatrix"))) + ## Add the mean structure only if there are means + if (!is.null(data) | !is.null(means)) { + + if (all(M==as.symMatrix(RAM$M))) { + mx.model <- mxModel(mx.model, Mmatrix) } else { - ## No mean structure - mx.model <- mxModel(mx.model, Fmatrix, Id, Id_A, expCov, - mxCI(c("Amatrix", "Smatrix"))) + M <- as.mxAlgebra(M, startvalues=startvalues, name="Mmatrix") + mx.model <- mxModel(mx.model, M$mxalgebra, M$parameters, M$list) } - - ## Add additional arguments to mxModel - if (!is.null(mxModel.Args)) { - for (i in seq_along(mxModel.Args)) { - mx.model <- mxModel(mx.model, mxModel.Args[[i]]) - } + + expMean <- mxAlgebra(Mmatrix %*% t(Id_A), name="expMean") + mx.model <- mxModel(mx.model, Fmatrix, Id, Id_A, expCov, expMean, + mxCI(c("Amatrix", "Smatrix", "Mmatrix"))) + } else { + ## No mean structure + mx.model <- mxModel(mx.model, Fmatrix, Id, Id_A, expCov, + mxCI(c("Amatrix", "Smatrix"))) + } + + ## Add additional arguments to mxModel + if (!is.null(mxModel.Args)) { + for (i in seq_along(mxModel.Args)) { + mx.model <- mxModel(mx.model, mxModel.Args[[i]]) + } + } + + ## A list of mxalgebras required SE or CI + mxalgebras.ci <- NULL + + ## Add mxAlgebra and mxConstraint from RAM$mxalgebra + if (!is.null(mxalgebras)) { + for (i in seq_along(mxalgebras)) { + mx.model <- mxModel(mx.model, mxalgebras[[i]]) + ## Name of the mxalgebra + name.mxalgebra <- names(mxalgebras)[i] + ## Check if the name constains constraint1, constraint2, ..., + ## If no, they are mxalgebra, not mxconstraints. Include them in mxCI. + if (!grepl("^constraint[0-9]", name.mxalgebra)) { + mx.model <- mxModel(mx.model, mxCI(c(name.mxalgebra))) + mxalgebras.ci <- c(mxalgebras.ci, name.mxalgebra) + } } + } - ## Add mxAlgebra and mxConstraint from RAM$mxalgebra - if (!is.null(mxalgebras)) { - for (i in seq_along(mxalgebras)) { - mx.model <- mxModel(mx.model, mxalgebras[[i]]) - ## Name of the mxalgebra - name.mxalgebra <- names(mxalgebras)[i] - ## Check if the name constains constraint1, constraint2, ..., - ## If no, they are mxalgebra, not mxconstraints. Include them in mxCI. - if (!grepl("^constraint[0-9]", name.mxalgebra)) { - mx.model <- mxModel(mx.model, mxCI(c(name.mxalgebra))) - } - } + if (run==FALSE) return(mx.model) + + ## Default is z + mx.fit <- tryCatch(mxRun(mx.model, intervals=(intervals.type=="LB"), + suppressWarnings=TRUE, silent=TRUE, ...), + error=function(e) e) + + ## Check if any errors + if (inherits(mx.fit, "error")) { + mx.fit <- mxTryHard(mx.model, extraTries=50, intervals=FALSE, silent=TRUE) + mx.fit <- tryCatch(mxRun(mx.fit, intervals=(intervals.type=="LB"), + suppressWarnings=TRUE, silent=TRUE, ...), + error=function(e) e) + if (inherits(mx.fit, "error")) { + warning("Error in running mxModel.\n") + } + } + + out <- list(mx.fit=mx.fit, RAM=RAM, data=data, mxalgebras=mxalgebras.ci, + intervals.type=intervals.type) + class(out) <- "mxRAMmodel" + out +} + +summary.mxRAMmodel <- function(object, robust=FALSE, ...) { + if (!is.element("mxRAMmodel", class(object))) + stop("\"object\" must be an object of class \"mxRAMmodel\".") + + # calculate coefficients + my.mx <- summary(object$mx.fit) + ## Exclude lbound ubound etc + my.para <- my.mx$parameters[, 1:6, drop=FALSE] + + # Determine if CIs on parameter estimates are present + if (object$intervals.type=="z") { + + ## Replace the SEs with robust SEs + if (robust) { + my.robust <- suppressMessages(imxRobustSE(object$mx.fit)) + my.para[, "Std.Error"] <- my.robust[my.para$name] } + + my.para$lbound <- with(my.para, Estimate - qnorm(.975)*Std.Error) + my.para$ubound <- with(my.para, Estimate + qnorm(.975)*Std.Error) + coefficients <- my.para[, -c(1:4), drop=FALSE] + dimnames(coefficients)[[1]] <- my.para$name + + } else { + + ## Convert a data frame with length of 0 in my.mx$CI and remove the last column "note" + my.ci <- my.mx$CI + if (length(my.ci)==0) my.ci <- NULL else my.ci <- my.ci[, 1:3, drop=FALSE] - if (run==TRUE) { - if (mxTryHard==TRUE) { - out <- mxTryHard(mx.model, intervals=intervals, silent=silent, ...) - } else { - out <- mxRun(mx.model, intervals=intervals, silent=silent, ...) - } + ## Select the elements matched my.para (excluded I2) + my.ci <- my.ci[row.names(my.ci) %in% my.para$name, ] + + my.ci <- data.frame(name=row.names(my.ci), my.ci) + my.para <- merge(my.para, my.ci, by=c("name")) + coefficients <- my.para[, -c(1:4,8)] + dimnames(coefficients)[[1]] <- my.para$name + # NA for LBCI + coefficients$Std.Error <- NA + } + + coefficients$"z value" <- coefficients$Estimate/coefficients$Std.Error + coefficients$"Pr(>|z|)" <- 2*(1-pnorm(abs(coefficients$"z value"))) + + informationCriteria <- my.mx$informationCriteria + ## Better column names + colnames(informationCriteria) <- c("df Penalty", "Parameters Penalty", + "Sample-Size Adjusted") + + ## Get the mxalgebras + if (!is.null(object$mxalgebras)) { + if (object$intervals.type=="z") { + estimate <- eval(parse(text=paste0("mxEval(rbind(", + paste(object$mxalgebras, collapse=","), + "), object$mx.fit)"))) + SE <- eval(parse(text=paste0("mxSE(rbind(", + paste(object$mxalgebras, collapse=","), + "), model=object$mx.fit, silent=TRUE)"))) + mxalgebras <- cbind(lbound=estimate - 1.96*SE, + estimate=estimate, + ubound=estimate + 1.96*SE) + dimnames(mxalgebras) <- list(object$mxalgebras, + c("lbound", "estimate", "ubound")) } else { - out <- mx.model + my.ci <- my.mx$CI + index <- NULL + for (i in seq_along(object$mxalgebras)) { + ## Get the names of the mxalgebras combined with the model name + index <- c(index, grep(paste(object$mx.fit$name, object$mxalgebras[i], sep="."), + rownames(my.mx$CI))) + } + mxalgebras <- my.mx$CI[index, c("lbound", "estimate", "ubound")] + dimnames(mxalgebras) <- list(object$mxalgebras, + c("lbound", "estimate", "ubound")) } + } else { + mxalgebras <- NULL + } + + out <- list(coefficients=coefficients, mxalgebras=mxalgebras, + intervals.type=object$intervals.type, + robust=robust, no.studies=my.mx$numObs, + obsStat=my.mx$observedStatistics, + estPara=my.mx$estimatedParameters, df=my.mx$degreesOfFreedom, + Minus2LL=my.mx$Minus2LogLikelihood, + Mx.status1=object$mx.fit@output$status[[1]], + informationCriteria=informationCriteria) + class(out) <- "summary.mxRAMmodel" out } + +print.summary.mxRAMmodel <- function(x, ...) { + if (!is.element("summary.mxRAMmodel", class(x))) { + stop("\"x\" must be an object of class \"summary.mxRAMmodel\".") + } + + cat("95% confidence intervals: ") + switch(x$intervals.type, + z = cat("z statistic approximation (robust=", x$robust, ")", sep=""), + LB = cat("Likelihood-based statistic") ) + + cat("\nCoefficients:\n") + printCoefmat(x$coefficients, P.values=TRUE, ...) + + if (!is.null(x$mxalgebras)) { + cat("\nMxalgebras:\n") + print(x$mxalgebras) + } + + cat("\nInformation Criteria:\n") + print(x$informationCriteria) + + cat("\nNumber of subjects (or studies):", x$no.studies) + cat("\nNumber of observed statistics:", x$obsStat) + cat("\nNumber of estimated parameters:", x$estPara) + cat("\nDegrees of freedom:", x$df) + cat("\n-2 log likelihood:", x$Minus2LL, "\n") + cat("OpenMx status1:", x$Mx.status1, "(\"0\" or \"1\": The optimization is considered fine.\nOther values may indicate problems.)\n") + + if (!(x$Mx.status1 %in% c(0,1))) warning("OpenMx status1 is neither 0 or 1. You are advised to 'rerun' it again.\n") +} + +coef.mxRAMmodel <- function(object, ...) { + if (!is.element("mxRAMmodel", class(object))) + stop("\"object\" must be an object of class \"mxRAMmodel\".") + + coef(object$mx.fit) +} + +vcov.mxRAMmodel <- function(object, robust=FALSE, ...) { + if (!is.element("mxRAMmodel", class(object))) + stop("\"object\" must be an object of class \"mxRAMmodel\".") + + if (robust) { + suppressMessages(imxRobustSE(object$mx.fit, details=TRUE)$cov) + } else { + vcov(object$mx.fit) + } +} + +anova.mxRAMmodel <- function(object, ..., all=FALSE) { + base <- lapply(list(object), function(x) x$mx.fit) + comparison <- lapply(list(...), function(x) x$mx.fit) + mxCompare(base=base, comparison=comparison, all=all) +} + +plot.mxRAMmodel <- function(x, manNames=NULL, latNames=NULL, + labels=c("labels", "RAM"), what="est", nCharNodes=0, + nCharEdges=0, layout=c("tree", "circle", "spring", + "tree2", "circle2"), + sizeMan=8, sizeLat=8, edge.label.cex=1.3, + color="white", weighted=FALSE, ...) { + + if (!requireNamespace("semPlot", quietly=TRUE)) + stop("\"semPlot\" package is required for this function.") + + if (!inherits(x, "mxRAMmodel")) + stop("'mxRAMmodel' object is required.\n") + + A <- x$mx.fit@matrices$Amatrix$values + S <- x$mx.fit@matrices$Smatrix$values + F <- x$mx.fit@matrices$Fmatrix$values + M <- x$mx.fit@matrices$Mmatrix$values + RAM <- x$RAM + + ## When there are definition variables, data in the first role are used in + ## the output. Better to replace it with their means. + for (i in seq_len(nrow(S))) + for (j in seq_len(ncol(S))) { + if (grepl("data.", RAM$S[i, j])) { + tmp <- strsplit(RAM$S[i, j], "data.", fixed=TRUE)[[1]][2] + S[i, j] <- eval(parse(text=paste0("mean(x$data$", tmp, ", na.rm=TRUE)"))) + } + } + + for (i in seq_len(nrow(A))) + for (j in seq_len(ncol(A))) { + if (grepl("data.", RAM$A[i, j])) { + tmp <- strsplit(RAM$A[i, j], "data.", fixed=TRUE)[[1]][2] + A[i, j] <- eval(parse(text=paste0("mean(x$data$", tmp, ", na.rm=TRUE)"))) + } + } + + for (j in seq_len(ncol(M))) { + if (grepl("data.", RAM$M[1, j])) { + tmp <- strsplit(RAM$M[1, j], "data.", fixed=TRUE)[[1]][2] + M[1, j] <- eval(parse(text=paste0("mean(x$data$", tmp, ", na.rm=TRUE)"))) + } + } + + ## index of observed variables + index_obs <- (apply(F, 2, sum)==1) + allNames <- colnames(A) + manNames <- allNames[index_obs] + latNames <- allNames[!index_obs] + + sem.plot <- semPlot::ramModel(A=A, S=S, F=F, M=M, manNames=manNames, latNames=latNames) + + invisible( semPlot::semPaths(sem.plot, what=what, nCharNodes=nCharNodes, + nCharEdges=nCharEdges, layout=match.arg(layout), + sizeMan=sizeMan, sizeLat=sizeLat, + edge.label.cex=edge.label.cex, color=color, + weighted=weighted, ...) ) +} diff --git a/R/impliedR.R b/R/impliedR.R index f8a4983..e272330 100644 --- a/R/impliedR.R +++ b/R/impliedR.R @@ -1,139 +1,160 @@ -impliedR <- function(RAM, Amatrix, Smatrix, Fmatrix, corr=TRUE, labels, ...) { +impliedR <- function(RAM, Amatrix, Smatrix, Fmatrix, Mmatrix, corr=TRUE, + labels, ...) { - if (!missing(RAM)) { - Amatrix <- RAM$A - Smatrix <- RAM$S - Fmatrix <- RAM$F - } + if (!missing(RAM)) { + Amatrix <- RAM$A + Smatrix <- RAM$S + Fmatrix <- RAM$F + Mmatrix <- RAM$M + } - if (missing(Smatrix)) { - stop("\"Smatrix\" matrix is not specified.\n") - } else { - if (is.matrix(Smatrix)) Smatrix <- as.mxMatrix(Smatrix) - ## No. of observed and latent variables - p <- nrow(Smatrix@values) - Smatrix@name <- "Smatrix" - } + if (missing(Smatrix)) { + stop("\"Smatrix\" matrix is not specified.\n") + } else { + if (is.matrix(Smatrix)) Smatrix <- as.mxMatrix(Smatrix) + ## No. of observed and latent variables + p <- nrow(Smatrix@values) + Smatrix@name <- "Smatrix" + } - if (missing(Amatrix)) { - stop("\"Amatrix\" matrix is not specified.\n") - } else { - if (is.matrix(Amatrix)) Amatrix <- as.mxMatrix(Amatrix) - Amatrix@name <- "Amatrix" - } + if (missing(Amatrix)) { + stop("\"Amatrix\" matrix is not specified.\n") + } else { + if (is.matrix(Amatrix)) Amatrix <- as.mxMatrix(Amatrix) + Amatrix@name <- "Amatrix" + } - if (missing(Fmatrix)) { - Fmatrix <- as.mxMatrix(Diag(p), name="Fmatrix") - } else { - if (is.matrix(Fmatrix)) Fmatrix <- as.mxMatrix(Fmatrix) - Fmatrix@name <- "Fmatrix" - } - - ## A pxp identity matrix - Id <- as.mxMatrix(Diag(p), name="Id") + if (missing(Fmatrix)) { + Fmatrix <- as.mxMatrix(Diag(p), name="Fmatrix") + } else { + if (is.matrix(Fmatrix)) Fmatrix <- as.mxMatrix(Fmatrix) + Fmatrix@name <- "Fmatrix" + } + + if (corr | missing(Mmatrix)) { + Mmatrix <- as.mxMatrix(matrix(0, nrow=1, ncol=p), name="Mmatrix") + } else { + if (is.matrix(Mmatrix)) Mmatrix <- as.mxMatrix(Mmatrix) + Mmatrix@name <- "Mmatrix" + } + + ## A pxp identity matrix + Id <- as.mxMatrix(Diag(p), name="Id") - ## Model implied correlation/covariance matrix including latent variables - SigmaAll <- mxAlgebra( solve(Id-Amatrix) %&% Smatrix, name="SigmaAll" ) + ## Model implied correlation/covariance matrix including latent variables + SigmaAll <- mxAlgebra( solve(Id-Amatrix) %&% Smatrix, name="SigmaAll" ) - ## Model implied correlation/covariance matrix of the observed variables - SigmaObs <- mxAlgebra( Fmatrix %&% SigmaAll, name="SigmaObs" ) + ## Model implied correlation/covariance matrix of the observed variables + SigmaObs <- mxAlgebra( Fmatrix %&% SigmaAll, name="SigmaObs" ) - if (corr) { - ## Create One vector for the diagonal constraint - One <- create.mxMatrix(rep(1,p), type="Full", ncol=1, nrow=p, name="One") + ## Model implied mean + Mu <- mxAlgebra( Mmatrix %*% t(Fmatrix %*% solve(Id-Amatrix)), name="Mu") + + if (corr) { + ## Create One vector for the diagonal constraint + One <- create.mxMatrix(rep(1,p), type="Full", ncol=1, nrow=p, name="One") - ## Ensure observed and latent are standardized - minFit <- mxAlgebra( sum((One-diag2vec(SigmaAll))^2), name="minFit" ) + ## Ensure observed and latent are standardized + minFit <- mxAlgebra( sum((One-diag2vec(SigmaAll))^2), name="minFit" ) - model <- mxModel(model="impliedR", Amatrix, Smatrix, Fmatrix, Id, One, - SigmaAll, SigmaObs, minFit, - mxFitFunctionAlgebra("minFit")) - } else { - ## Covariance matrix, no need for the constraint - model <- mxModel(model="impliedSigma", Amatrix, Smatrix, Fmatrix, Id, - SigmaAll, SigmaObs) - } + model <- mxModel(model="impliedR", Amatrix, Smatrix, Fmatrix, Mmatrix, + Id, One, SigmaAll, SigmaObs, Mu, minFit, + mxFitFunctionAlgebra("minFit")) + } else { + ## Covariance matrix, no need for the constraint + model <- mxModel(model="impliedSigma", Amatrix, Smatrix, Fmatrix, Mmatrix, + Id, SigmaAll, SigmaObs, Mu) + } - mx.fit <- mxRun(model, silent=TRUE) + mx.fit <- mxRun(model, silent=TRUE) - A <- eval(parse(text = "mxEval(Amatrix, mx.fit)")) - S <- eval(parse(text = "mxEval(Smatrix, mx.fit)")) - F <- eval(parse(text = "mxEval(Fmatrix, mx.fit)")) - SigmaObs <- eval(parse(text = "mxEval(SigmaObs, mx.fit)")) - SigmaAll <- eval(parse(text = "mxEval(SigmaAll, mx.fit)")) + A <- eval(parse(text = "mxEval(Amatrix, mx.fit)")) + S <- eval(parse(text = "mxEval(Smatrix, mx.fit)")) + F <- eval(parse(text = "mxEval(Fmatrix, mx.fit)")) + M <- eval(parse(text = "mxEval(Mmatrix, mx.fit)")) + SigmaObs <- eval(parse(text = "mxEval(SigmaObs, mx.fit)")) + SigmaAll <- eval(parse(text = "mxEval(SigmaAll, mx.fit)")) + Mu <- eval(parse(text = "mxEval(Mu, mx.fit)")) - ## Create the labels for the matrices - ## Index for the observed variables - index <- apply(Fmatrix@values, 1, function(x) which(x==1)) + ## Create the labels for the matrices + ## Index for the observed variables + index <- apply(Fmatrix@values, 1, function(x) which(x==1)) - if (missing(labels)) { - if (!is.null(dimnames(Smatrix@values))) { - labels <- colnames(Smatrix@values) - } else if (!is.null(dimnames(Amatrix@values))) { - labels <- colnames(Amatrix@values) - } else if (!is.null(dimnames(Fmatrix@values))) { - labels <- colnames(Fmatrix@values) - } else { - labels <- NULL - } - } else if (length(labels)!=p) { - warning("Length of \"labels\" is different from the number of variables.\n") + if (missing(labels)) { + if (!is.null(dimnames(Smatrix@values))) { + labels <- colnames(Smatrix@values) + } else if (!is.null(dimnames(Amatrix@values))) { + labels <- colnames(Amatrix@values) + } else if (!is.null(dimnames(Fmatrix@values))) { + labels <- colnames(Fmatrix@values) + } else { + labels <- NULL } + } else if (length(labels)!=p) { + warning("Length of \"labels\" is different from the number of variables.\n") + } - if (!is.null(labels)) { - labels.obs <- labels[index] - dimnames(A) <- dimnames(S) <- dimnames(SigmaAll) <- list(labels, labels) - dimnames(SigmaObs) <- list(labels.obs, labels.obs) - dimnames(F) <- list(labels.obs, labels) - } + if (!is.null(labels)) { + labels.obs <- labels[index] + dimnames(A) <- dimnames(S) <- dimnames(SigmaAll) <- list(labels, labels) + dimnames(SigmaObs) <- list(labels.obs, labels.obs) + dimnames(F) <- list(labels.obs, labels) + dimnames(M) <- list("1", labels) + dimnames(Mu) <- list("1", labels.obs) + } - if (corr) { - ## minFit is the amount of misfit on the constraints - ## It should be close to zero. - minFit <- c(eval(parse(text = "mxEval(minFit, mx.fit)"))) - status <- c(mx.fit$output$status[[1]]) - } else { - ## It is zero by definition for covariance matrix. - minFit <- 0 - status <- 0 - } + if (corr) { + ## minFit is the amount of misfit on the constraints + ## It should be close to zero. + minFit <- c(eval(parse(text = "mxEval(minFit, mx.fit)"))) + status <- c(mx.fit$output$status[[1]]) + } else { + ## It is zero by definition for covariance matrix. + minFit <- 0 + status <- 0 + } - if (!isTRUE(all.equal(minFit, 0))) { - warning("The diagonals of the correlation matrix are not zero! ", - "You should not trust the results.\n") - } - - if (status!=0) { - warning("The status code of optimization is non-zero. ", - "Please check if there are too many free parameters in your population model.\n") - } + if (!isTRUE(all.equal(minFit, 0))) { + warning("The diagonals of the correlation matrix are not zero! ", + "You should not trust the results.\n") + } + + if (status!=0) { + warning("The status code of optimization is non-zero. ", + "Please check if there are too many free parameters in your population model.\n") + } - out <- list(A=A, S=S, F=F, SigmaObs=SigmaObs, SigmaAll=SigmaAll, corr=corr, - minFit=minFit, status=status, mx.fit=mx.fit) - class(out) <- "impliedR" - out + out <- list(A=A, S=S, F=F, M=M, SigmaObs=SigmaObs, SigmaAll=SigmaAll, Mu=Mu, + corr=corr, minFit=minFit, status=status, mx.fit=mx.fit) + class(out) <- "impliedR" + out } print.impliedR <- function(x, ...) { if (!is.element("impliedR", class(x))) - stop("\"x\" must be an object of class \"uniR1\".") + stop("\"x\" must be an object of class \"impliedR\".") cat("Amatrix:\n") print(x$A) cat("\nSmatrix:\n") print(x$S) cat("\nFmatrix:\n") print(x$F) - cat("\nSigma of the observed variables:\n") + cat("\nMmatrix:\n") + print(x$M) + cat("\nModel implied matrix of the observed variables:\n") print(x$SigmaObs) - cat("\nSigma of both the observed and latent variables:\n") + cat("\nModel implied matrix of the observed and latent variables:\n") print(x$SigmaAll) + cat("\nModel implied vector of the observed means:\n") + print(x$Mu) cat("\nCorrelation matrix:", x$corr) cat("\nSigma of the observed variables is positive definite:", is.pd(x$SigmaObs)) cat("\nSigma of both the observed and latent variables is positive definite:", is.pd(x$SigmaAll)) if (x$corr) { cat("\nMinimum value of the fit function (it should be close to 0 for correlation analysis): ", x$minFit) - cat("\nStatus code of the optimization (it should be 0 for correlation analysis): ", x$status, "\n") + cat("\nStatus code of the optimization (it should be 0 for correlation analysis): ", x$status) } + cat("\n") } ## Generate model implied matrices from random parameters @@ -141,112 +162,112 @@ print.impliedR <- function(x, ...) { rimpliedR <- function(RAM, Amatrix, Smatrix, Fmatrix, AmatrixSD, SmatrixSD, k=1, corr=TRUE, nonPD.pop=c("replace", "nearPD", "accept")) { - ## Only values are used in matrices - if (!missing(RAM)) { - Amatrix <- RAM$A - Smatrix <- RAM$S - Fmatrix <- RAM$F - } + ## Only values are used in matrices + if (!missing(RAM)) { + Amatrix <- RAM$A + Smatrix <- RAM$S + Fmatrix <- RAM$F + } - ## No. of observed variables - p <- ncol(Amatrix) - ## No. of elements in Amatrix - # n <- p*p + ## No. of observed variables + p <- ncol(Amatrix) + ## No. of elements in Amatrix + # n <- p*p - ## All variables are observed. - if (missing(Fmatrix)) Fmatrix <- Diag(p) + ## All variables are observed. + if (missing(Fmatrix)) Fmatrix <- Diag(p) - ## If missing SD matrices, use a zero matrix - if (missing(AmatrixSD)) AmatrixSD <- matrix(0, ncol=p, nrow=p) - if (missing(SmatrixSD)) SmatrixSD <- matrix(0, ncol=p, nrow=p) - - if (!all(sapply(list(dim(Amatrix), dim(Smatrix), dim(SmatrixSD)), - FUN=identical, dim(AmatrixSD)))) - stop("Dimensions of \"Amatrix\", \"Smatrix\", \"AmatrixSD\", and \"SmatrixSD\" must be the same.") + ## If missing SD matrices, use a zero matrix + if (missing(AmatrixSD)) AmatrixSD <- matrix(0, ncol=p, nrow=p) + if (missing(SmatrixSD)) SmatrixSD <- matrix(0, ncol=p, nrow=p) + + if (!all(sapply(list(dim(Amatrix), dim(Smatrix), dim(SmatrixSD)), + FUN=identical, dim(AmatrixSD)))) + stop("Dimensions of \"Amatrix\", \"Smatrix\", \"AmatrixSD\", and \"SmatrixSD\" must be the same.") - ## Try to get the labels of all variables from A and then S - labels <- colnames(Amatrix) - if (is.null(labels)) labels <- colnames(Smatrix) + ## Try to get the labels of all variables from A and then S + labels <- colnames(Amatrix) + if (is.null(labels)) labels <- colnames(Smatrix) - ## Select the labels of the observed variables - if (!is.null(labels)) labels <- labels[as.logical(colSums(Fmatrix))] + ## Select the labels of the observed variables + if (!is.null(labels)) labels <- labels[as.logical(colSums(Fmatrix))] - ## A vector of means of Amatrix by column major - A.mean <- as.numeric(Amatrix) - ## A diagonal matrix of variances of Amatrix by column major - A.var <- diag(c(AmatrixSD^2)) - - ## Model implied R or S - impR1 <- impliedR(Amatrix=Amatrix, Smatrix=Smatrix, corr=corr) - ## A vector of means of Smatrix - if (corr) { - S.mean <- vechs(impR1$S) - S.var <- diag(vechs(SmatrixSD^2)) - } else { - S.mean <- vech(impR1$S) - S.var <- diag(vech(SmatrixSD^2)) - } + ## A vector of means of Amatrix by column major + A.mean <- as.numeric(Amatrix) + ## A diagonal matrix of variances of Amatrix by column major + A.var <- diag(c(AmatrixSD^2)) + + ## Model implied R or S + impR1 <- impliedR(Amatrix=Amatrix, Smatrix=Smatrix, corr=corr) + ## A vector of means of Smatrix + if (corr) { + S.mean <- vechs(impR1$S) + S.var <- diag(vechs(SmatrixSD^2)) + } else { + S.mean <- vech(impR1$S) + S.var <- diag(vech(SmatrixSD^2)) + } - nonPD.pop <- match.arg(nonPD.pop) - ## Count for nonPD matrices - nonPD.count <- 0 - - ## Generate a model implied R and return if it is PD - genImpR <- function() { - ## Generate random A matrix - A <- matrix(mvtnorm::rmvnorm(n=1, mean=A.mean, sigma=A.var), ncol=p, nrow=p) - ## Generate random S matrix - S <- mvtnorm::rmvnorm(n=1, mean=S.mean, sigma=S.var) - ## Convert S back to a pxp matrix - S <- vec2symMat(S, diag=!corr) - ## Replace the diagonals from the model implied R - ## Elements are either 1 or starting values - if (corr) diag(S) <- diag(Smatrix) + nonPD.pop <- match.arg(nonPD.pop) + ## Count for nonPD matrices + nonPD.count <- 0 + + ## Generate a model implied R and return if it is PD + genImpR <- function() { + ## Generate random A matrix + A <- matrix(mvtnorm::rmvnorm(n=1, mean=A.mean, sigma=A.var), ncol=p, nrow=p) + ## Generate random S matrix + S <- mvtnorm::rmvnorm(n=1, mean=S.mean, sigma=S.var) + ## Convert S back to a pxp matrix + S <- vec2symMat(S, diag=!corr) + ## Replace the diagonals from the model implied R + ## Elements are either 1 or starting values + if (corr) diag(S) <- diag(Smatrix) - impR2 <- impliedR(Amatrix=A, Smatrix=S, Fmatrix=Fmatrix, corr=corr) - - ## isPD includes: status=0 and PD - list(R=impR2$SigmaObs, isPD=(impR2$status==0 & is.pd(impR2$SigmaObs))) - } + impR2 <- impliedR(Amatrix=A, Smatrix=S, Fmatrix=Fmatrix, corr=corr) + + ## isPD includes: status=0 and PD + list(R=impR2$SigmaObs, isPD=(impR2$status==0 & is.pd(impR2$SigmaObs))) + } - ## Generate random correlation matrices - genCor <- function() { - impR3 <- genImpR() - R <- impR3$R - isPD <- impR3$isPD + ## Generate random correlation matrices + genCor <- function() { + impR3 <- genImpR() + R <- impR3$R + isPD <- impR3$isPD - ## R is nonPD - if (!isPD) { - ## global rather than local assignment - nonPD.count <<- nonPD.count+1 - switch(nonPD.pop, - replace = while (!isPD) { - impR4 <- genImpR() - R <- impR4$R - ## isPD includes: status=0 and PD - isPD <- impR4$isPD - nonPD.count <<- nonPD.count+1 - }, - nearPD = {R <- as.matrix(Matrix::nearPD(R, corr=corr, - keepDiag=corr)$mat)}, - accept = {} ) - } - ## Ad hoc, R may not be symmetric due to the precision - R[lower.tri(R)] <- t(R)[lower.tri(t(R))] - if (!is.null(labels)) dimnames(R) <- list(labels, labels) - R - } - - ## Repeat it k times - ## Simplify it when AmatrixSD=0 and SmatrixSD=0 - if (all(c(AmatrixSD, SmatrixSD)==0)) { - tmp <- genCor() - out <- replicate(n=k, tmp, simplify=FALSE) - } else { - out <- replicate(n=k, genCor(), simplify=FALSE) + ## R is nonPD + if (!isPD) { + ## global rather than local assignment + nonPD.count <<- nonPD.count+1 + switch(nonPD.pop, + replace = while (!isPD) { + impR4 <- genImpR() + R <- impR4$R + ## isPD includes: status=0 and PD + isPD <- impR4$isPD + nonPD.count <<- nonPD.count+1 + }, + nearPD = {R <- as.matrix(Matrix::nearPD(R, corr=corr, + keepDiag=corr)$mat)}, + accept = {} ) } + ## Ad hoc, R may not be symmetric due to the precision + R[lower.tri(R)] <- t(R)[lower.tri(t(R))] + if (!is.null(labels)) dimnames(R) <- list(labels, labels) + R + } + + ## Repeat it k times + ## Simplify it when AmatrixSD=0 and SmatrixSD=0 + if (all(c(AmatrixSD, SmatrixSD)==0)) { + tmp <- genCor() + out <- replicate(n=k, tmp, simplify=FALSE) + } else { + out <- replicate(n=k, genCor(), simplify=FALSE) + } - attr(out, "k") <- k - attr(out, "nonPD.count") <- nonPD.count - out + attr(out, "k") <- k + attr(out, "nonPD.count") <- nonPD.count + out } diff --git a/R/osmasem.R b/R/osmasem.R index e4f5098..b570e4c 100644 --- a/R/osmasem.R +++ b/R/osmasem.R @@ -420,7 +420,7 @@ create.V <- function(x, type=c("Symm", "Diag", "Full"), as.mxMatrix=TRUE) { osmasem <- function(model.name="osmasem", RAM=NULL, Mmatrix=NULL, Tmatrix=NULL, Jmatrix=NULL, Ax=NULL, Sx=NULL, A.lbound=NULL, A.ubound=NULL, - RE.type=c("Diag", "Symm"), data, + RE.type=c("Diag", "Symm", "Zero"), data, subset.variables=NULL, subset.rows=NULL, intervals.type = c("z", "LB"), mxModel.Args=NULL, mxRun.Args=NULL, diff --git a/R/rerun.R b/R/rerun.R index 822fa3a..4bf63d3 100644 --- a/R/rerun.R +++ b/R/rerun.R @@ -1,72 +1,83 @@ rerun <- function(object, autofixtau2=FALSE, extraTries=10, ...) { - if (!is.element(class(object)[1], c("wls", "tssem1FEM", "tssem1REM", "meta", "meta3LFIML", "reml", - "tssem1FEM.cluster", "wls.cluster", "osmasem", "osmasem3L", "MxModel"))) - stop("\"object\" must be an object of neither class \"meta\", \"meta3LFIML\", \"wls\", -\"reml\", \"tssem1FEM\", \"tssem1REM\", \"tssem1FEM.cluster\", \"wls.cluster\", \"osmasem\", \"osmasem3L\", or \"MxModel\".") + if (!is.element(class(object)[1], c("wls", "tssem1FEM", "tssem1REM", "meta", + "meta3LFIML", "reml", + "tssem1FEM.cluster", "wls.cluster", + "osmasem", "osmasem3L", "MxModel", + "mxRAMmodel"))) + stop("\"object\" must be an object of neither class \"meta\", \"meta3LFIML\", \"wls\", \"reml\", \"tssem1FEM\", \"tssem1REM\", \"tssem1FEM.cluster\", \"wls.cluster\", \"osmasem\", \"osmasem3L\", \"MxModel\", or \"mxRAMModel\".") - ## Run a rerun without autofixtau2 to minimize over-fixing - ## Many of the NA in SEs may disappear after rerunning it. - if (autofixtau2 & is.element(class(object)[1], c("tssem1REM", "meta", "osmasem"))) { - object <- rerun(object, autofixtau2=FALSE, extraTries=extraTries, ...) - } + ## Run a rerun without autofixtau2 to minimize over-fixing + ## Many of the NA in SEs may disappear after rerunning it. + if (autofixtau2 & is.element(class(object)[1], c("tssem1REM", "meta", "osmasem"))) { + object <- rerun(object, autofixtau2=FALSE, extraTries=extraTries, ...) + } + + ## Automatically fix the problematic Tau2 into 0 for tssem1REM and meta objects + if (autofixtau2 & is.element(class(object)[1], c("tssem1REM", "meta"))) { + ## Get the Tau2 with NA is SE + tau2nan <- suppressWarnings(sqrt(diag(vcov(object, select="random")))) - ## Automatically fix the problematic Tau2 into 0 for tssem1REM and meta objects - if (autofixtau2 & is.element(class(object)[1], c("tssem1REM", "meta"))) { - ## Get the Tau2 with NA is SE - tau2nan <- suppressWarnings(sqrt(diag(vcov(object, select="random")))) - - ## Check if tau2nan exists; otherwise names(tau2nan) returns error - if (any(tau2nan <- is.nan(tau2nan))) { - ## Keep elements with NAN (TRUE) - tau2nan <- tau2nan[tau2nan] - ## Fix the Tau2 at 0 - object$mx.fit <- omxSetParameters(object$mx.fit, names(tau2nan), free=FALSE, values=0) - } + ## Check if tau2nan exists; otherwise names(tau2nan) returns error + if (any(tau2nan <- is.nan(tau2nan))) { + ## Keep elements with NAN (TRUE) + tau2nan <- tau2nan[tau2nan] + ## Fix the Tau2 at 0 + object$mx.fit <- omxSetParameters(object$mx.fit, names(tau2nan), + free=FALSE, values=0) } + } - ## Automatically fix the problematic Tau2 into 0 for osmasem objects - if (autofixtau2 & is.element(class(object)[1], "osmasem")) { - ## Check if there are negative variances - tau2nan <- suppressWarnings(sqrt(diag(vcov(object, select="random")))) + ## Automatically fix the problematic Tau2 into 0 for osmasem objects + if (autofixtau2 & is.element(class(object)[1], "osmasem")) { + ## Check if there are negative variances + tau2nan <- suppressWarnings(sqrt(diag(vcov(object, select="random")))) - if (any(tau2nan <- is.nan(tau2nan))) { - tau2nan <- tau2nan[tau2nan] + if (any(tau2nan <- is.nan(tau2nan))) { + tau2nan <- tau2nan[tau2nan] - ## FIXME: Need to check how robust it is for "Symm" and "User" - ## Dirty fix to check whether the transformation is expLog or sqSD - ## Remove all white spaces - my.transform <- gsub("\\s", "", deparse(object$mx.fit$Tau2$formula)) - if (grep("exp", my.transform)) { - ## exp(-Inf)=0 - values = -Inf - ## Assuming sdSD - } else { - ## 0^2=0 - values = 0 - } - object$mx.fit <- omxSetParameters(object$mx.fit, names(tau2nan), free=FALSE, values=values) - } - } + ## FIXME: Need to check how robust it is for "Symm" and "User" + ## Dirty fix to check whether the transformation is expLog or sqSD + ## Remove all white spaces + my.transform <- gsub("\\s", "", deparse(object$mx.fit$Tau2$formula)) + if (grep("exp", my.transform)) { + ## exp(-Inf)=0 + values = -Inf + ## Assuming sdSD + } else { + ## 0^2=0 + values = 0 + } + object$mx.fit <- omxSetParameters(object$mx.fit, names(tau2nan), + free=FALSE, values=values) + } + } - ## Cluster related objects - if (is.element(class(object)[1], c("tssem1FEM.cluster", "wls.cluster"))) { - out <- lapply(object, rerun, extraTries=extraTries, ...) - class(out) <- class(object)[1] - ## Pure MxModel objects - } else if (is.element(class(object)[1], "MxModel")) { - out <- mxTryHard(object, extraTries=extraTries, greenOK=TRUE, paste=FALSE, bestInitsOutput=FALSE, ...) - ## Other metaSEM objects + ## Cluster related objects + if (is.element(class(object)[1], c("tssem1FEM.cluster", "wls.cluster"))) { + out <- lapply(object, rerun, extraTries=extraTries, ...) + class(out) <- class(object)[1] + ## Pure MxModel objects + } else if (is.element(class(object)[1], "MxModel")) { + out <- mxTryHard(object, extraTries=extraTries, greenOK=TRUE, paste=FALSE, + bestInitsOutput=FALSE, ...) + ## Other metaSEM objects + } else { + out <- object + ## No LB option + if (is.null(object$intervals.type)) { + out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, + greenOK=TRUE, paste=FALSE, bestInitsOutput=FALSE, + ...) } else { - out <- object - ## No LB option - if (is.null(object$intervals.type)) { - out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, greenOK=TRUE, paste=FALSE, bestInitsOutput=FALSE, ...) - } else { - switch(object$intervals.type, - z = out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, greenOK=TRUE, paste=FALSE, bestInitsOutput=FALSE, ...), - LB =out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, greenOK=TRUE, paste=FALSE, bestInitsOutput=FALSE, - intervals=TRUE, ...)) - } - } - out + switch(object$intervals.type, + z = out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, + greenOK=TRUE, paste=FALSE, + bestInitsOutput=FALSE, ...), + LB =out$mx.fit <- mxTryHard(object$mx.fit, extraTries=extraTries, + greenOK=TRUE, paste=FALSE, + bestInitsOutput=FALSE, + intervals=TRUE, ...)) + } + } + out } diff --git a/R/summary.R b/R/summary.R index a3f5faa..9f844d4 100644 --- a/R/summary.R +++ b/R/summary.R @@ -1164,23 +1164,23 @@ anova.meta3LFIML <- function(object, ..., all=FALSE) { mxCompare(base=base, comparison=comparison, all=all) } -coef.MxRAMModel <- function(object, ...) { - if (!is.element("MxRAMModel", class(object))) - stop("\"object\" must be an object of class \"MxRAMModel\".") - omxGetParameters(object, ...) -} +## coef.MxRAMModel <- function(object, ...) { +## if (!is.element("MxRAMModel", class(object))) +## stop("\"object\" must be an object of class \"MxRAMModel\".") +## omxGetParameters(object, ...) +## } -vcov.MxRAMModel <- function(object, ...) { - if (!is.element("MxRAMModel", class(object))) - stop("\"object\" must be an object of class \"MxRAMModel\".") +## vcov.MxRAMModel <- function(object, ...) { +## if (!is.element("MxRAMModel", class(object))) +## stop("\"object\" must be an object of class \"MxRAMModel\".") - # labels of the parameters - my.name <- names( omxGetParameters(object) ) - # Remove NA labels - my.name <- my.name[!is.na(my.name)] +## # labels of the parameters +## my.name <- names( omxGetParameters(object) ) +## # Remove NA labels +## my.name <- my.name[!is.na(my.name)] - .solve(x=object@output$calculatedHessian, parameters=my.name) -} +## .solve(x=object@output$calculatedHessian, parameters=my.name) +## } ## VarCorr.meta <- function(x, sigma=1, ...) { ## if (!is.element("meta", class(x))) diff --git a/man/Aloe14.Rd b/man/Aloe14.Rd index 047d46a..607a124 100644 --- a/man/Aloe14.Rd +++ b/man/Aloe14.Rd @@ -32,7 +32,7 @@ \source{Aloe, A. M., Amo, L. C., & Shanahan, M. E. (2014). Classroom management self-efficacy and burnout: A multivariate meta-analysis. \emph{Educational Psychology Review}, \bold{26(1)}, 101-126. doi:10.1007/s10648-013-9244-0 } \examples{ -\dontrun{ +\donttest{ data(Aloe14) ## Random-effects meta-analysis diff --git a/man/Becker09.Rd b/man/Becker09.Rd index 45a0877..6776612 100644 --- a/man/Becker09.Rd +++ b/man/Becker09.Rd @@ -27,7 +27,7 @@ Craft, L. L., Magyar, T. M., Becker, B. J., & Feltz, D. L. (2003). The relations Becker, B. J. (2009). Model-based meta-analysis. In H. Cooper, L. V. Hedges, & J. C. Valentine (Eds.), \emph{The handbook of research synthesis and meta-analysis} (2nd ed., pp. 377-395). New York: Russell Sage Foundation. } \examples{ -\dontrun{ +\donttest{ data(Becker09) #### Fixed-effects model diff --git a/man/Becker92.Rd b/man/Becker92.Rd index b9acdec..c3a39c1 100644 --- a/man/Becker92.Rd +++ b/man/Becker92.Rd @@ -23,7 +23,7 @@ A list of data with the following structure: } \examples{ -\dontrun{ +\donttest{ data(Becker92) #### Fixed-effects model diff --git a/man/Becker94.Rd b/man/Becker94.Rd index 48c93d6..4e4a06e 100644 --- a/man/Becker94.Rd +++ b/man/Becker94.Rd @@ -26,7 +26,7 @@ A list of data with the following structure: } \examples{ -\dontrun{ +\donttest{ data(Becker94) #### Fixed-effects model diff --git a/man/Berkey98.Rd b/man/Berkey98.Rd index e301b97..52d9fb7 100644 --- a/man/Berkey98.Rd +++ b/man/Berkey98.Rd @@ -26,7 +26,7 @@ Berkey, C. S., Hoaglin, D. C., Antczak-Bouckoms, A., Mosteller, F, & Colditz, G. A. (1998). Meta-analysis of multiple outcomes by regression with random effects. \emph{Statistics in Medicine}, \bold{17}, 2537-2550. } \examples{ -\dontrun{ +\donttest{ data(Berkey98) #### ML estimation method diff --git a/man/Boer16.Rd b/man/Boer16.Rd index 09caa9e..15878b1 100644 --- a/man/Boer16.Rd +++ b/man/Boer16.Rd @@ -25,7 +25,7 @@ A list of data with the following structure: Boer, D., Deinert, A., Homan, A. C., & Voelpel, S. C. (2016). Revisiting the mediating role of leader-member exchange in transformational leadership: the differential impact model. \emph{European Journal of Work and Organizational Psychology}, \bold{25}(6), 883-899. } \examples{ -\dontrun{ +\donttest{ ## Stage 1 analysis rand1 <- tssem1(Boer16$data, Boer16$n, method="REM", RE.type="Diag", acov="weighted") diff --git a/man/Bornmann07.Rd b/man/Bornmann07.Rd index ba74182..020c11d 100644 --- a/man/Bornmann07.Rd +++ b/man/Bornmann07.Rd @@ -32,7 +32,7 @@ Marsh, H. W., Bornmann, L., Mutz, R., Daniel, H.-D., & O'Mara, A. (2009). Gender Effects in the Peer Reviews of Grant Proposals: A Comprehensive Meta-Analysis Comparing Traditional and Multilevel Approaches. \emph{Review of Educational Research}, \bold{79(3)}, 1290-1326. doi:10.3102/0034654309334143 } \examples{ -\dontrun{ +\donttest{ data(Bornmann07) #### ML estimation method diff --git a/man/Cheung00.Rd b/man/Cheung00.Rd index 97e98c3..75c5a6a 100644 --- a/man/Cheung00.Rd +++ b/man/Cheung00.Rd @@ -32,7 +32,7 @@ A list of data with the following structure: coefficients were also excluded. } \examples{ -\dontrun{ +\donttest{ data(Cheung00) ## Variable labels diff --git a/man/Cheung09.Rd b/man/Cheung09.Rd index 98d0c70..5777a97 100644 --- a/man/Cheung09.Rd +++ b/man/Cheung09.Rd @@ -24,7 +24,7 @@ A list of data with the following structure: Cheung, M. W.-L., & Chan, W. (2009). A two-stage approach to synthesizing covariance matrices in meta-analytic structural equation modeling. \emph{Structural Equation Modeling}, \bold{16}, 28-53. } \examples{ -\dontrun{ +\donttest{ data(Cheung09) #### Fixed-effects model: Stage 1 analysis diff --git a/man/Cooke16.Rd b/man/Cooke16.Rd index d1355b6..8ed04e2 100644 --- a/man/Cooke16.Rd +++ b/man/Cooke16.Rd @@ -31,7 +31,7 @@ A list of data with the following structure: } \examples{ -\dontrun{ +\donttest{ ## Check whether the correlation matrices are valid (positive definite) Cooke16$data[is.pd(Cooke16$data)==FALSE] diff --git a/man/Cooper03.Rd b/man/Cooper03.Rd index f650a6d..2f9c71c 100644 --- a/man/Cooper03.Rd +++ b/man/Cooper03.Rd @@ -26,7 +26,7 @@ Methods}, \bold{2}, 61-76. doi:10.1002/jrsm.35 } \examples{ -\dontrun{ +\donttest{ data(Cooper03) #### ML estimation method diff --git a/man/Cor2DataFrame.Rd b/man/Cor2DataFrame.Rd index e8804b4..61342f7 100644 --- a/man/Cor2DataFrame.Rd +++ b/man/Cor2DataFrame.Rd @@ -49,7 +49,7 @@ Cor2DataFrame(x, n, v.na.replace = TRUE, row.names.unique = FALSE, \examples{ -\dontrun{ +\donttest{ ## Provide a list of correlation matrices and a vector of sample sizes as the inputs my.df1 <- Cor2DataFrame(Nohe15A1$data, Nohe15A1$n) diff --git a/man/Digman97.Rd b/man/Digman97.Rd index 6ee2ff2..0e77ff4 100644 --- a/man/Digman97.Rd +++ b/man/Digman97.Rd @@ -24,7 +24,7 @@ Digman, J.M. (1997). Higher-order factors of the Big Five. \emph{Journal of Pers Cheung, M. W.-L., & Chan, W. (2005). Classifying correlation matrices into relatively homogeneous subgroups: A cluster analytic approach. \emph{Educational and Psychological Measurement}, \bold{65}, 954-979. } \examples{ -\dontrun{ +\donttest{ Digman97 ##### Fixed-effects TSSEM diff --git a/man/Gleser94.Rd b/man/Gleser94.Rd index 1bf5144..18151b1 100644 --- a/man/Gleser94.Rd +++ b/man/Gleser94.Rd @@ -21,7 +21,7 @@ } \examples{ -\dontrun{ +\donttest{ data(Gleser94) #### Multiple-treatment studies diff --git a/man/Hox02.Rd b/man/Hox02.Rd index da82c2c..fb9ca4f 100644 --- a/man/Hox02.Rd +++ b/man/Hox02.Rd @@ -24,7 +24,7 @@ Hox, J. J. (2002). \emph{Multilevel analysis: Techniques and applications.} Mahw Cheung, M. W.-L. (2008). A model for integrating fixed-, random-, and mixed-effects meta-analyses into structural equation modeling. \emph{Psychological Methods}, \bold{13}, 182-202. } \examples{ -\dontrun{ +\donttest{ data(Hox02) #### ML estimation method diff --git a/man/Hunter83.Rd b/man/Hunter83.Rd index c1331e2..c178ed1 100644 --- a/man/Hunter83.Rd +++ b/man/Hunter83.Rd @@ -22,7 +22,7 @@ A list of data with the following structure: } \examples{ -\dontrun{ +\donttest{ data(Hunter83) #### Fixed-effects model diff --git a/man/Jaramillo05.Rd b/man/Jaramillo05.Rd index 5b40c73..a376603 100644 --- a/man/Jaramillo05.Rd +++ b/man/Jaramillo05.Rd @@ -29,7 +29,7 @@ } \examples{ -\dontrun{ +\donttest{ ## Research question 4.4.1 summary(meta(r, r_v, data=Jaramillo05)) diff --git a/man/Kalaian96.Rd b/man/Kalaian96.Rd index 1390c36..960696e 100644 --- a/man/Kalaian96.Rd +++ b/man/Kalaian96.Rd @@ -36,7 +36,7 @@ with a common correlation of 0.66} } \examples{ -\dontrun{ +\donttest{ data(Kalaian96) } } diff --git a/man/Mathieu15.Rd b/man/Mathieu15.Rd index c33bf5f..6fe0bd5 100644 --- a/man/Mathieu15.Rd +++ b/man/Mathieu15.Rd @@ -24,7 +24,7 @@ A list of data with the following structure: Mathieu, J. E., Kukenberger, M. R., D'Innocenzo, L., & Reilly, G. (2015). Modeling reciprocal team cohesion-performance relationships, as impacted by shared leadership and members' competence. \emph{Journal of Applied Psychology}, \bold{100}(3), 713-734. https://doi.org/10.1037/a0038898 } \examples{ -\dontrun{ +\donttest{ # TSSEM ## Model 1: no constraint ## Stage 1 analysis diff --git a/man/Nohe15.Rd b/man/Nohe15.Rd index a809a67..00c25c9 100644 --- a/man/Nohe15.Rd +++ b/man/Nohe15.Rd @@ -32,7 +32,7 @@ A list of data with the following structure: Nohe, C., Meier, L. L., Sonntag, K., & Michel, A. (2015). The chicken or the egg? A meta-analysis of panel studies of the relationship between work-family conflict and strain. \emph{Journal of Applied Psychology}, \bold{100}(2), 522-536. } \examples{ -\dontrun{ +\donttest{ #### TSSEM ## Set seed for replicability diff --git a/man/Roorda11.Rd b/man/Roorda11.Rd index 5e80d73..f1889bb 100644 --- a/man/Roorda11.Rd +++ b/man/Roorda11.Rd @@ -29,7 +29,7 @@ achievement reported by Roorda et al. (2011). Methods}, \bold{50}, 1359-1373. } \examples{ -\dontrun{ +\donttest{ ## Random-effects model: First stage analysis random1 <- tssem1(Cov = Roorda11$data, n = Roorda11$n, method = "REM", diff --git a/man/Tenenbaum02.Rd b/man/Tenenbaum02.Rd index 06b3b1a..02915e5 100644 --- a/man/Tenenbaum02.Rd +++ b/man/Tenenbaum02.Rd @@ -34,7 +34,7 @@ } \examples{ -\dontrun{ +\donttest{ data(Tenenbaum02) } } diff --git a/man/anova.Rd b/man/anova.Rd index 2b4d5c3..adc6f28 100644 --- a/man/anova.Rd +++ b/man/anova.Rd @@ -4,6 +4,7 @@ \alias{anova.meta3LFIML} \alias{anova.reml} \alias{anova.osmasem} +\alias{anova.mxRAMmodel} \title{Compare Nested Models with Likelihood Ratio Statistic } \description{It compares nested models with the likelihood ratio @@ -15,6 +16,7 @@ \method{anova}{meta3LFIML}(object, \dots, all=FALSE) \method{anova}{reml}(object, \dots, all=FALSE) \method{anova}{osmasem}(object, \dots, all=FALSE) +\method{anova}{mxRAMmodel}(object, \dots, all=FALSE) } %- maybe also 'usage' for other objects documented here. \arguments{ diff --git a/man/asyCov.Rd b/man/asyCov.Rd index 5329533..7c56a97 100644 --- a/man/asyCov.Rd +++ b/man/asyCov.Rd @@ -77,7 +77,7 @@ Yuan, K.-H., & Bentler, P. M. (2007). Robust procedures in structural equation m compatibility.} \examples{ -\dontrun{ +\donttest{ C1 <- matrix(c(1,0.5,0.4,0.5,1,0.2,0.4,0.2,1), ncol=3) asyCov(C1, n=100) diff --git a/man/calEffSizes.Rd b/man/calEffSizes.Rd index 493f1b3..e36fe87 100644 --- a/man/calEffSizes.Rd +++ b/man/calEffSizes.Rd @@ -42,7 +42,7 @@ calEffSizes(model, data=NULL, n, Cov, Mean=NULL, group=NULL, lavaan.output=FALSE %% ~~objects to See Also as \code{\link{help}}, ~~~ } \examples{ -\dontrun{ +\donttest{ ## Select ATT, Bi, and BEH obs.vars <- c("BEH", "BI", "ATT") diff --git a/man/checkRAM.Rd b/man/checkRAM.Rd index 0ddf105..489e518 100644 --- a/man/checkRAM.Rd +++ b/man/checkRAM.Rd @@ -27,7 +27,7 @@ checkRAM(Amatrix, Smatrix, cor.analysis=TRUE) \code{\link[metaSEM]{lavaan2RAM}} } \examples{ -\dontrun{ +\donttest{ ## Digman97 example model1 <- "## Factor loadings Alpha=~A+C+ES diff --git a/man/coef.Rd b/man/coef.Rd index bd8b339..b9629c5 100644 --- a/man/coef.Rd +++ b/man/coef.Rd @@ -7,8 +7,8 @@ \alias{coef.meta} \alias{coef.meta3LFIML} \alias{coef.reml} -\alias{coef.MxRAMModel} \alias{coef.osmasem} +\alias{coef.mxRAMmodel} \title{Extract Parameter Estimates from various classes. } @@ -24,15 +24,15 @@ \method{coef}{meta}(object, select = c("all", "fixed", "random"), \dots) \method{coef}{meta3LFIML}(object, select = c("all", "fixed", "random", "allX"), \dots) \method{coef}{reml}(object, \dots) -\method{coef}{MxRAMModel}(object, \dots) \method{coef}{osmasem}(object, select=c("fixed", "all", "random"), \dots) +\method{coef}{mxRAMmodel}(object, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ \item{object}{An object returned from either class \code{tssem1FEM}, class \code{tssem1FEM.cluster}, class \code{tssem1REM}, class \code{wls}, class \code{wls.cluster}, class \code{meta}, class - \code{reml} or class \code{MxRAMModel} + \code{reml} or class \code{mxRAMmodel} } \item{select}{Select \code{all} for both fixed- and random-effects parameters, \code{fixed} for the fixed-effects parameters or \code{random} for the random-effects @@ -41,7 +41,7 @@ } \item{\dots}{Further arguments; currently none is used} } -\note{\code{coef.MxRAMModel} is simply a wraper of +\note{\code{coef.mxRAMmodel} is simply a wraper of \code{omxGetParameters}. Extra arguments will be passed to it} \value{Parameter estimates for both fixed-effects (if any) and random-effects (if any) diff --git a/man/create.Tau2.Rd b/man/create.Tau2.Rd index c5b6053..f165654 100644 --- a/man/create.Tau2.Rd +++ b/man/create.Tau2.Rd @@ -52,7 +52,7 @@ create.Tau2(RAM, no.var, Tau1.labels=seq(no.var), } \examples{ -\dontrun{ +\donttest{ T0 <- create.Tau2(no.var=4, RE.type="Diag", Transform="expLog", RE.startvalues=0.05) T0 diff --git a/man/create.V.Rd b/man/create.V.Rd index 9d170f7..ba2441d 100644 --- a/man/create.V.Rd +++ b/man/create.V.Rd @@ -27,7 +27,7 @@ create.V(x, type = c("Symm", "Diag", "Full"), as.mxMatrix = TRUE) } \examples{ -\dontrun{ +\donttest{ my.df <- Cor2DataFrame(Nohe15A1) ## Create known sampling variance covariance matrix diff --git a/man/create.mxModel.Rd b/man/create.mxModel.Rd index f1dd76e..31bfe91 100644 --- a/man/create.mxModel.Rd +++ b/man/create.mxModel.Rd @@ -7,9 +7,9 @@ \usage{ create.mxModel(model.name="mxModel", RAM=NULL, data=NULL, Cov=NULL, means=NULL, numObs, - intervals.type = c("z", "LB"), startvalues=NULL, - mxModel.Args=NULL, run=TRUE, mxTryHard=FALSE, - silent=TRUE, ...) + intervals.type=c("z", "LB"), startvalues=NULL, + replace.constraints=FALSE, mxModel.Args=NULL, + run=TRUE, silent=TRUE, ...) } \arguments{ \item{model.name}{A string for the model name in \code{\link[OpenMx]{mxModel}}. @@ -25,25 +25,24 @@ create.mxModel(model.name="mxModel", RAM=NULL, data=NULL, intervals (CIs) based on the estimated standard error. If it is \code{LB}, it calculates the 95\% likelihood-based CIs on the parameter estimates.} -\item{startvalues}{A list of starting values for the free parameters.} +\item{startvalues}{A list of named starting values of the free parameters, e.g., list(a=1, b=2)} +\item{replace.constraints}{Logical. If \code{TRUE}, the parameters on the left hand side will be replaced by the constraints on the right hand side. That is, the parameters on the left hand side are no longer parameters in the model.} \item{mxModel.Args}{A list of arguments passed to \code{\link[OpenMx]{mxModel}}.} \item{run}{Logical. If \code{FALSE}, only return the mx model without running the analysis.} -\item{mxTryHard}{If \code{TRUE}, call \code{mxTryHard} to run the - analysis. If \code{FALSE}, call \code{mxRun} to run the analysis.} \item{silent}{Logical. An argument is passed to either \code{\link[OpenMx]{mxRun}} or \code{\link[OpenMx]{mxTryHard}}} \item{\dots}{Further arguments will be passed to either \code{\link[OpenMx]{mxRun}} or \code{\link[OpenMx]{mxTryHard}}} } - -\value{An object of class \code{mxModel}} - +\value{An object of class \code{mxRAMmodel}} +\note{when there are constraints with \code{replace.constraints=TRUE} and \code{intervals.type="LB"}, it returns an error because some parameters in the model are replaced with the new parameters in the constraints. However, the names of these new parameters are not captured in the CI object. Users are advised to use \code{intervals.type="z"} before it is fixed. +} \author{Mike W.-L. Cheung } \examples{ -\dontrun{ +\donttest{ ## Generate data set.seed(100) n <- 100 diff --git a/man/create.vechsR.Rd b/man/create.vechsR.Rd index 5def031..2a17e78 100644 --- a/man/create.vechsR.Rd +++ b/man/create.vechsR.Rd @@ -34,7 +34,7 @@ create.vechsR(A0, S0, F0 = NULL, Ax = NULL, Sx = NULL, A.lbound=NULL, A.ubound=N } \examples{ -\dontrun{ +\donttest{ ## Proposed model model1 <- 'W2 ~ w2w*W1 + s2w*S1 S2 ~ w2s*W1 + s2s*S1 diff --git a/man/impliedR.Rd b/man/impliedR.Rd index 57b1295..da5bb11 100644 --- a/man/impliedR.Rd +++ b/man/impliedR.Rd @@ -7,7 +7,7 @@ matrices based on the RAM model specification. } \usage{ -impliedR(RAM, Amatrix, Smatrix, Fmatrix, corr=TRUE, labels, ...) +impliedR(RAM, Amatrix, Smatrix, Fmatrix, Mmatrix, corr=TRUE, labels, ...) rimpliedR(RAM, Amatrix, Smatrix, Fmatrix, AmatrixSD, SmatrixSD, k=1, corr=TRUE, nonPD.pop=c("replace", "nearPD", "accept")) } @@ -35,6 +35,7 @@ rimpliedR(RAM, Amatrix, Smatrix, Fmatrix, AmatrixSD, SmatrixSD, \code{\link[OpenMx]{MxMatrix-class}} by the \code{as.mxMatrix} function. It is not required when there is no latent variable. } +\item{Mmatrix}{An optional matrix of the mean vector. It is assumed zeros if missing.} \item{AmatrixSD}{Standard deviations (SD) of the elements in the \code{Amatrix}. If it is missing, a matrix of zero is created.} \item{SmatrixSD}{Standard deviations (SD) of the elements in the @@ -90,6 +91,14 @@ rimpliedR(RAM, Amatrix, Smatrix, Fmatrix, AmatrixSD, SmatrixSD, \examples{ set.seed(100) +## A one-factor CFA model +model <- "f =~ 0.3*x1 + 0.4*x2 + 0.5*x3 + f ~~ 1*f" + +RAM <- lavaan2RAM(model) + +impliedR(RAM, corr=TRUE) + ## A simple mediation model ## All are population parameters in the A matrix A1 <- matrix(c(0, 0, 0, diff --git a/man/issp05.Rd b/man/issp05.Rd index 77d5d64..3643d42 100644 --- a/man/issp05.Rd +++ b/man/issp05.Rd @@ -32,7 +32,7 @@ A list of data with the following structure: \examples{ -\dontrun{ +\donttest{ data(issp05) #### Fixed-effects TSSEM diff --git a/man/issp89.Rd b/man/issp89.Rd index 79a3645..78e1ee1 100644 --- a/man/issp89.Rd +++ b/man/issp89.Rd @@ -33,7 +33,7 @@ Cheung, M. W.-L., & Chan, W. (2009). A two-stage approach to synthesizing covari \seealso{ \code{\link[metaSEM]{issp05}} } \examples{ -\dontrun{ +\donttest{ data(issp89) #### Analysis of correlation structure in Cheung and Chan (2005) diff --git a/man/metaSEM-package.Rd b/man/metaSEM-package.Rd index cfcdd06..6eb82c1 100644 --- a/man/metaSEM-package.Rd +++ b/man/metaSEM-package.Rd @@ -7,15 +7,15 @@ \description{A collection of functions for conducting meta-analysis using a structural equation modeling (SEM) approach via the 'OpenMx' and 'lavaan' packages. It also implements various procedures to - perform meta-analytic structural equation modeling on the + perform meta-analytic structural equation modeling on the correlation and covariance matrices. } \details{ \tabular{ll}{ Package: \tab metaSEM\cr Type: \tab Package\cr -Version: \tab 1.3.1\cr -Date: \tab 2023-08-08\cr +Version: \tab 1.4.0\cr +Date: \tab 2024-04-08\cr License: \tab GPL (>=2)\cr LazyLoad: \tab yes\cr } diff --git a/man/osmasem.Rd b/man/osmasem.Rd index 751d217..2c37e57 100644 --- a/man/osmasem.Rd +++ b/man/osmasem.Rd @@ -8,7 +8,7 @@ osmasem(model.name="osmasem", RAM=NULL, Mmatrix=NULL, Tmatrix=NULL, Jmatrix=NULL, Ax=NULL, Sx=NULL, A.lbound=NULL, A.ubound=NULL, - RE.type=c("Diag", "Symm"), data, + RE.type=c("Diag", "Symm", "Zero"), data, subset.variables=NULL, subset.rows=NULL, intervals.type = c("z", "LB"), mxModel.Args=NULL, mxRun.Args=NULL, diff --git a/man/plot.Rd b/man/plot.Rd index f108741..0697341 100644 --- a/man/plot.Rd +++ b/man/plot.Rd @@ -3,6 +3,7 @@ \alias{plot.character} \alias{plot.wls} \alias{plot.osmasem} +\alias{plot.mxRAMmodel} \title{Plot methods for various objects } @@ -40,6 +41,11 @@ what="est", nCharNodes=0, nCharEdges=0, layout=c("tree", "circle", "spring", "tree2", "circle2"), sizeMan=8, sizeLat=8, edge.label.cex=1.3, color="white", + weighted=FALSE, \dots) +\method{plot}{mxRAMmodel}(x, manNames=NULL, latNames=NULL, labels=c("labels", "RAM"), + what="est", nCharNodes=0, nCharEdges=0, + layout=c("tree", "circle", "spring", "tree2", "circle2"), + sizeMan=8, sizeLat=8, edge.label.cex=1.3, color="white", weighted=FALSE, \dots) } %- maybe also 'usage' for other objects documented here. @@ -190,7 +196,7 @@ \seealso{ \code{\link[metaSEM]{Berkey98}}, \code{\link[metaSEM]{wvs94a}} \code{\link[metaSEM]{meta2semPlot}} \code{\link[semPlot]{semPaths}}} \examples{ -\dontrun{ +\donttest{ ## lavaan model model <- "y ~ m + x m ~ x" diff --git a/man/readData.Rd b/man/readData.Rd index f3dcd4f..3389efb 100644 --- a/man/readData.Rd +++ b/man/readData.Rd @@ -28,7 +28,7 @@ readLowTriMat(file, no.var, ...) } \examples{ -\dontrun{ +\donttest{ ## Write two full correlation matrices into a file named "fullmat.dat". ## x2 is missing in the second matrix. ## The content of "fullmat.dat" is diff --git a/man/rerun.Rd b/man/rerun.Rd index 9cd2159..125498a 100644 --- a/man/rerun.Rd +++ b/man/rerun.Rd @@ -24,7 +24,7 @@ rerun(object, autofixtau2=FALSE, extraTries=10, ...) } \examples{ -\dontrun{ +\donttest{ random1 <- tssem1(Digman97$data, Digman97$n, method="REM", RE.type="Diag") random1_rerun <- rerun(random1) summary(random1_rerun) diff --git a/man/smdMES.Rd b/man/smdMES.Rd index 9304961..7c09ea5 100644 --- a/man/smdMES.Rd +++ b/man/smdMES.Rd @@ -64,7 +64,7 @@ smdMES(m1, m2, V1, V2, n1, n2, } \examples{ -\dontrun{ +\donttest{ ## Sample means for the two constructs in Group 1 m1 <- c(2.5, 4.5) diff --git a/man/smdMTS.Rd b/man/smdMTS.Rd index d7fef61..6d885f8 100644 --- a/man/smdMTS.Rd +++ b/man/smdMTS.Rd @@ -58,7 +58,7 @@ smdMTS(m, v, n, homogeneity=c("variance", "none"), bias.adjust=TRUE, } \examples{ -\dontrun{ +\donttest{ ## Sample means for groups 1 to 3 m <- c(5,7,9) diff --git a/man/summary.Rd b/man/summary.Rd index 73f4993..4b0593a 100644 --- a/man/summary.Rd +++ b/man/summary.Rd @@ -11,6 +11,7 @@ \alias{summary.Cor3L} \alias{summary.bootuniR2} \alias{summary.osmasem} +\alias{summary.mxRAMmodel} \alias{print.summary.tssem1FEM} \alias{print.summary.tssem1FEM.cluster} \alias{print.summary.wls} @@ -20,6 +21,7 @@ \alias{print.summary.CorPop} \alias{print.summary.Cor3L} \alias{print.summary.bootuniR2} +\alias{print.summary.mxRAMmodel} \title{Summary Method for tssem1, wls, meta, and meta3LFIML Objects } \description{It summaries results for various class. @@ -33,6 +35,7 @@ \method{summary}{meta}(object, homoStat=TRUE, robust=FALSE, \dots) \method{summary}{meta3LFIML}(object, allX=FALSE, robust=FALSE, \dots) \method{summary}{reml}(object, \dots) +\method{summary}{mxRAMmodel}(object, robust=FALSE, \dots) \method{summary}{CorPop}(object, \dots) \method{summary}{Cor3L}(object, \dots) \method{summary}{bootuniR2}(object, probs=c(0, 0.1, 0.5, 0.9, 1), @@ -44,6 +47,7 @@ \method{print.summary}{meta}(x, \dots) \method{print.summary}{meta3LFIML}(x, \dots) \method{print.summary}{reml}(x, \dots) +\method{print.summary}{mxRAMmodel}(x, \dots) \method{print.summary}{CorPop}(x, \dots) \method{print.summary}{Cor3L}(x, \dots) \method{print.summary}{bootuniR2}(x, \dots) diff --git a/man/vcov.Rd b/man/vcov.Rd index 8cab428..fb510f8 100644 --- a/man/vcov.Rd +++ b/man/vcov.Rd @@ -7,8 +7,8 @@ \alias{vcov.meta} \alias{vcov.meta3LFIML} \alias{vcov.reml} -\alias{vcov.MxRAMModel} \alias{vcov.osmasem} +\alias{vcov.mxRAMmodel} \title{Extract Covariance Matrix Parameter Estimates from Objects of Various Classes } @@ -24,8 +24,8 @@ \method{vcov}{meta}(object, select = c("all", "fixed", "random"), robust=FALSE, \dots) \method{vcov}{meta3LFIML}(object, select = c("all", "fixed", "random","allX"), robust=FALSE, \dots) \method{vcov}{reml}(object, \dots) -\method{vcov}{MxRAMModel}(object, \dots) \method{vcov}{osmasem}(object, select=c("fixed", "all", "random"), robust=FALSE, \dots) +\method{vcov}{mxRAMmodel}(object, robust=FALSE, \dots) } %- maybe also 'usage' for other objects documented here. \arguments{ diff --git a/man/wls.Rd b/man/wls.Rd index de340e2..48321e3 100644 --- a/man/wls.Rd +++ b/man/wls.Rd @@ -152,7 +152,7 @@ McArdle, J. J., & MacDonald, R. P. (1984). Some algebraic properties of the Reti \code{\link[metaSEM]{Hunter83}}, \code{\link[metaSEM]{issp89}}, \code{\link[metaSEM]{issp05}} } \examples{ -\dontrun{ +\donttest{ #### Analysis of correlation structure R1.labels <- c("a1", "a2", "a3", "a4") diff --git a/man/wvs94a.Rd b/man/wvs94a.Rd index 5590af8..1971dd4 100644 --- a/man/wvs94a.Rd +++ b/man/wvs94a.Rd @@ -34,7 +34,7 @@ satisfaction and life control in each country were calculated as the effect size Cheung, M. W.-L. (2013). Multivariate meta-analysis as structural equation models. \emph{Structural Equation Modeling}, \bold{20}, 429-454. } \examples{ -\dontrun{ +\donttest{ data(wvs94a) ## Random-effects model diff --git a/man/wvs94b.Rd b/man/wvs94b.Rd index 51e4e15..3bb8f10 100644 --- a/man/wvs94b.Rd +++ b/man/wvs94b.Rd @@ -31,7 +31,7 @@ covariance matrices among Life Satisfaction, Job Satisfaction, and Job Autonomy illustrations. \emph{Research Synthesis Methods}, \bold{7}, 140-155. } \examples{ -\dontrun{ +\donttest{ data(wvs94b) ## Get the indirect and the direct effects and diff --git a/tests/testthat/test_utilities.R b/tests/testthat/test_utilities.R index b103b07..df55e4b 100644 --- a/tests/testthat/test_utilities.R +++ b/tests/testthat/test_utilities.R @@ -596,7 +596,7 @@ test_that("metaFIML() works correctly", { expect_equal(coef1a, coef1b, tolerance=tolerance) expect_equal(vcov(fit1a), vcov(fit1b)[names1, names1], tolerance=tolerance) expect_equal(fit1a$mx.fit$output$Minus2LogLikelihood, - fit1b$output$Minus2LogLikelihood) + fit1b$mx.fit$output$Minus2LogLikelihood) ## Univariate meta-analysis with AV fit2a <- metaFIML(y=r, v=r_v, x=JP_alpha, av=IDV, data=Jaramillo05) @@ -632,7 +632,7 @@ test_that("metaFIML() works correctly", { v_fit2b <- vcov(fit2b)[names2, names2][-4, -4] expect_equal(v_fit2a, v_fit2b, tolerance=tolerance) expect_equal(fit2a$mx.fit$output$Minus2LogLikelihood, - fit2b$output$Minus2LogLikelihood) + fit2b$mx.fit$output$Minus2LogLikelihood) ## Multivariate meta-analysis without AV wvs94a$gnp <- scale(wvs94a$gnp) @@ -670,7 +670,7 @@ test_that("metaFIML() works correctly", { expect_equal(coef3a, coef3b, tolerance=tolerance) expect_equal(vcov(fit3a), vcov(fit3b)[names3, names3], tolerance=tolerance) expect_equal(fit3a$mx.fit$output$Minus2LogLikelihood, - fit3b$output$Minus2LogLikelihood) + fit3b$mx.fit$output$Minus2LogLikelihood) }) test_that("Handling NA in diagonals in tssem1FEM() correctly", {