Nothing
#' Run Mplus Models
#'
#' This function runs a group of Mplus models (\code{.inp} files) located within
#' a single directory or nested within subdirectories.
#'
#' @param target a character string indicating the directory containing
#' Mplus input files (\code{.inp}) to run or the single
#' \code{.inp} file to be run. May be a full path, relative
#' path, or a filename within the working directory.
#' @param recursive logical: if \code{TRUE}, run all models nested in
#' subdirectories within directory. Not relevant if target
#' is a single file.
#' @param filefilter a Perl regular expression (PCRE-compatible) specifying
#' particular input files to be run within directory. See
#' regex or http://www.pcre.org/pcre.txt for details about
#' regular expression syntax. Not relevant if target is a
#' single file.
#' @param show.out logical: if \code{TRUE}, estimation output (\code{TECH8})
#' is show on the R console. Note that if run within Rgui,
#' output will display within R, but if run via Rterm,
#' a separate window will appear during estimation.
#' @param replace.out a character string for specifying three settings:
#' \code{"always"} (default), which runs all models, regardless
#' of whether an output file for the model exists, \code{"never"},
#' which does not run any model that has an existing output
#' file, and \code{"modified"}, which only runs a model if
#' the modified date for the input file is more recent than
#' the output file modified date.
#' @param message logical: if \code{TRUE}, message \code{Running model:}
#' and \code{System command:} is printed on the console.
#' @param logFile a character string specifying a file that records the settings
#' passed into the function and the models run (or skipped)
#' during the run.
#' @param Mplus a character string for specifying the name or path of the
#' Mplus executable to be used for running models. This covers
#' situations where Mplus is not in the system's path, or where
#' one wants to test different versions of the Mplus program.
#' Note that there is no need to specify this argument for most
#' users since it has intelligent defaults.
#' @param killOnFail logical: if \code{TRUE} (default), all processes named
#' mplus.exe when \code{mplus.run()} does not terminate
#' normally are killed. Windows only.
#' @param local_tmpdir logical: if \code{TRUE}, the TMPDIR environment variable
#' is set to the location of the \code{.inp file} prior to
#' execution. This is useful in Monte Carlo studies where
#' many instances of Mplus may run in parallel and we wish
#' to avoid collisions in temporary files among processes.
#' Linux/Mac only.
#' @param check logical: if \code{TRUE} (default), argument specification is
#' checked.
#'
#' @author
#' Michael Hallquist and Joshua Wiley.
#'
#' @seealso
#' \code{\link{read.mplus}}, \code{\link{write.mplus}}, \code{\link{mplus}},
#' \code{\link{mplus.update}}, \code{\link{mplus.print}}, \code{\link{mplus.plot}},
#' \code{\link{mplus.bayes}}, \code{\link{mplus.lca}}
#'
#' @references
#' Hallquist, M. N. & Wiley, J. F. (2018). MplusAutomation
#' : An R package for facilitating
#' large-scale latent variable analyses in Mplus. \emph{Structural Equation Modeling:
#' A Multidisciplinary Journal, 25}, 621-638. https://doi.org/10.1080/10705511.2017.1402334.
#'
#' Muthen, L. K., & Muthen, B. O. (1998-2017). \emph{Mplus User's Guide} (8th ed.).
#' Muthen & Muthen.
#'
#' @return
#' None.
#'
#' @note
#' This function is a copy of the \code{runModels()} function in the
#' \pkg{MplusAutomation} package by Michael Hallquist and Joshua Wiley (2018).
#'
#' @export
#'
#' @examples
#' \dontrun{
#' # Example 1: Run Mplus models located within a single directory
#' mplus.run(Mplus = "C:/Program Files/Mplus/Mplus.exe")
#'
#' # Example 2: Run Mplus models located nested within subdirectories
#' mplus.run(recursive = TRUE, Mplus = "C:/Program Files/Mplus/Mplus.exe")
#' }
mplus.run <- function(target = getwd(), recursive = FALSE, filefilter = NULL, show.out = FALSE,
replace.out = c("always", "never", "modified"), message = TRUE,
logFile = NULL, Mplus = .detect.mplus(),
killOnFail = TRUE, local_tmpdir = FALSE, check = TRUE) {
#_____________________________________________________________________________
#
# Input Check ----------------------------------------------------------------
# Check inputs
.check.input(logical = c("recursive", "show.out", "message", "killOnFail", "local_tmpdir"),
character = list(Mplus = 1L), s.character = list(replace.out = c("always", "never", "modified")), envir = environment(), input.check = check)
#_____________________________________________________________________________
#
# Arguments ------------------------------------------------------------------
# Argument replace.out
if (isTRUE(all(c("always", "never", "modified") %in% replace.out))) { replace.out <- "always" }
#_____________________________________________________________________________
#
# Additional Functions -------------------------------------------------------
isLogOpen <- function() {
if (isTRUE(is.null(logFile))) return(FALSE)
connections <- data.frame(showConnections(all = FALSE))
if (isTRUE(length(grep(splitFilePath(logFile)$filename, connections$description, ignore.case = TRUE)) > 0L)) {
return(TRUE)
} else {
return(FALSE)
}
}
exitRun <- function() {
deleteOnKill <- TRUE
if (isTRUE(!normalComplete && isLogOpen())) {
writeLines("Run terminated abnormally", logTarget)
flush(logTarget)
}
if (isTRUE(is.windows() && isFALSE(normalComplete) && isTRUE(killOnFail))) {
processList <- plyr::ldply(strsplit(shell("wmic process get caption, processid", intern = TRUE), split = "\\s+", perl = TRUE),
function(element) {
return(data.frame(procname = element[1L], pid = element[2L], stringsAsFactors = FALSE))
})
if(isTRUE(length(grep("mplus.exe", processList$procname, ignore.case = TRUE)) > 0L)) {
if(isTRUE(isLogOpen())) {
writeLines("Killing wayward Mplus processes", logTarget)
flush(logTarget)
}
shell("taskkill /f /im mplus.exe")
if(isTRUE(deleteOnKill)) {
noExtension <- substr(cur_inpfile, length(cur_inpfile) - 4L, length(cur_inpfile))
outDelete <- paste0(noExtension, ".out")
gphDelete <- paste0(noExtension, ".gph")
if (isTRUE(file.exists(outDelete))) {
unlink(outDelete)
if(isTRUE(isLogOpen())) {
writeLines(paste("Deleting unfinished output file:", outDelete), logTarget)
flush(logTarget)
}
}
if (isTRUE(file.exists(gphDelete))) {
unlink(gphDelete)
if(isTRUE(isLogOpen())) {
writeLines(paste("Deleting unfinished graph file:", gphDelete), logTarget)
flush(logTarget)
}
}
}
}
}
if (isTRUE(isLogOpen())) { close(logTarget) }
setwd(curdir)
}
#_____________________________________________________________________________
#
# Main Function --------------------------------------------------------------
if (isTRUE(grepl("^~/", Mplus, perl = TRUE))) { Mplus <- normalizePath(Mplus) }
curdir <- getwd()
normalComplete <- FALSE
if (isTRUE(!is.null(logFile))) {
logTarget <- file(description = logFile, open = "wt", blocking = TRUE)
writeLines(c(paste0("------Begin Mplus Model Run: ", format(Sys.time(), "%d%b%Y %H:%M:%S"), "------"),
"Run options:",
paste("\tRecursive (run models in subdirectories):", as.character(recursive)),
paste("\tShow output on console:", as.character(show.out)),
paste("\tReplace existing outfile:", replace.out),
"------"), con = logTarget)
flush(logTarget)
}
on.exit(exitRun())
inp_files <- convert_to_filelist(target, filefilter, recursive)
if(isTRUE(length(inp_files) < 1L)) stop("No Mplus input files detected in the provided target: ", paste(target, collapse=", "))
outfiles <- unlist(lapply(inp_files, function(x) {
if (file.exists(otest <- sub("\\.inp?$", ".out", x))) {
return(otest)
} else {
return(NULL)
}
}))
dropOutExtensions <- sapply(outfiles, function(x) {
if (isTRUE(nchar(x) >= 4L)) return(tolower(substr(x, 1, (nchar(x) - 4L))))
})
for (i in seq_along(inp_files)) {
if (isFALSE(replace.out == "always")) {
if (isTRUE(tolower(sub("\\.inp?$", "", inp_files[i], perl=TRUE)) %in% dropOutExtensions)) {
if (isTRUE(replace.out == "modifiedDate")) {
inpmtime <- file.info(inp_files[i])$mtime
matchPos <- grep(tolower(substr(inp_files[i], 1L, (nchar(inp_files[i]) - 4L))), dropOutExtensions)
if (isTRUE(length(matchPos) < 1)) warning("Could not locate matching outfile")
outmtime <- file.info(outfiles[matchPos[1L]])$mtime
if (isTRUE(inpmtime <= outmtime)) {
if (isTRUE(isLogOpen())) {
writeLines(paste("Skipping model because output file is newer than input file:", inp_files[i]), logTarget)
flush(logTarget)
}
next
}
} else if (isTRUE(replace.out == "never")) {
if (isTRUE(isLogOpen())) {
writeLines(paste("Skipping model because output file already exists for:", inp_files[i]), logTarget)
flush(logTarget)
}
next
}
}
}
inputSplit <- splitFilePath(inp_files[i], normalize = TRUE)
cur_inpfile <- inp_files[i]
command <- paste("cd \"", inputSplit$directory, "\" && \"", Mplus, "\" \"", inputSplit$filename, "\"", sep="")
if (is.windows()) {
command <- chartr("/", "\\", command)
shellcommand <- Sys.getenv("COMSPEC")
flag <- "/c"
command <- paste(shellcommand, flag, command)
} else if (isTRUE(.Platform$OS.type == "unix")) {
# allow for unix-specific customization here
}
if (isTRUE(isLogOpen())) {
writeLines(paste("Currently running model:", inputSplit$filename), logTarget)
flush(logTarget)
}
if (isTRUE(message)) cat("\nRunning model:", inputSplit$filename, "\n")
if (isTRUE(message)) cat("System command:", command, "\n")
if (isTRUE(.Platform$OS.type == "windows")) {
the_output <- suppressWarnings(system(command, intern = TRUE, invisible = (!show.out), wait = TRUE))
if(show.out){ cat(the_output, sep = "\n") }
} else {
if(isTRUE(show.out)) stdout.value = ""
else stdout.value = NULL
oldwd <- getwd()
setwd(inputSplit$directory)
if (isTRUE(local_tmpdir)) { Sys.setenv(TMPDIR = inputSplit$directory) }
exitCode <- suppressWarnings(system2(Mplus, args=c(shQuote(inputSplit$filename)), stdout = stdout.value, wait=TRUE))
if (isTRUE(exitCode > 0L)) { warning("Mplus returned error code: ", exitCode, ", for model: ", inputSplit$filename, "\n") }
setwd(oldwd)
}
}
if (isTRUE(isLogOpen())) {
writeLines(c("", paste0("------End Mplus Model Run: ", format(Sys.time(), "%d%b%Y %H:%M:%S"), "------")), logTarget)
flush(logTarget)
}
normalComplete <- TRUE
}
#_______________________________________________________________________________
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.