R/scriptINULL.R

In jsakaluk/dySEM: Dyadic Structural Equation Modeling

#' A Function That Writes, Saves, and Exports Syntax for
#' Fitting the I-NULL model for indistinguishable dyads
#'
#' This function takes the outputted object from scrapeVarCross()
#' and automatically writes, returns, and exports (.txt) lavaan() syntax
#' for the I-NULL model described in Olsen & Kenny (2006)
#' @param dvn input dvn list from scrapeVarCross
#' @param lvxname input character to (arbitrarily) name X LV in lavaan syntax
#' @param lvyname (optional) input character to (arbitrarily) name Y LV in lavaan syntax
#' @param writeTo A character string specifying a directory path to where a .txt file of the resulting lavaan script should be written.
#' If set to “.”, the .txt file will be written to the current working directory.
#' The default is NULL, and examples use a temporary directory created by tempdir().
#' @param fileName A character string specifying a desired base name for the .txt output file.
#' The default is NULL. The specified name will be automatically appended with the .txt file extension.
#' If a file with the same name already exists in the user's chosen directory, it will be overwritten.
#' @return character object of lavaan script that can be passed immediately to
#' lavaan functions
#' @seealso \code{\link{scrapeVarCross}} which this function relies on
#' @family indistinguishable script-writing functions
#' @export
#' @examples
#' dvn <- scrapeVarCross(dat = DRES, x_order = "sip", x_stem = "PRQC", x_delim1 = "_",
#' x_delim2=".", x_item_num="\\d+", distinguish_1="1", distinguish_2="2")
#' qual.inull.script <- scriptINULL(dvn, lvxname = "Qual",
#' writeTo = tempdir(),
#' fileName = "I-NULL_script")
scriptINULL = function(
  dvn,
  lvxname = "X",
  lvyname = NULL,
  writeTo = NULL,
  fileName = NULL
) {
  #Intercepts equated between partners
  xints1 = intercepts(dvn, lvar = "X", partner = "1", type = "equated")
  xints2 = intercepts(dvn, lvar = "X", partner = "2", type = "equated")

  #If y-variable, equate their intercepts too
  if (length(dvn) == 9) {
    yints1 = intercepts(dvn, lvar = "Y", partner = "1", type = "equated")
    yints2 = intercepts(dvn, lvar = "Y", partner = "2", type = "equated")
  }

  #Variances equated between partners
  xvars1 <- resids(dvn, lvar = "X", partner = "1", type = "equated")
  xvars2 <- resids(dvn, lvar = "X", partner = "2", type = "equated")

  #If y-variable, equate their variances too
  if (length(dvn) == 9) {
    yvars1 <- resids(dvn, lvar = "Y", partner = "1", type = "equated")
    yvars2 <- resids(dvn, lvar = "Y", partner = "2", type = "equated")
  }

  #Constrain Covariances to 0
  if (length(dvn) == 6) {
    varname = c(dvn[["p1xvarnames"]], dvn[["p2xvarnames"]])
    covar.list = c()
    for (i in 1:dvn[["indnum"]]) {
      covar.list[[i]] = c(varname[i + 1:dvn[["indnum"]]])
    }
    covar.list <- covar.list[-c(dvn[["indnum"]])]
    covar.list <- lapply(covar.list, function(x) x[!is.na(x)])

    store = c()
    for (i in 1:length(covar.list)) {
      store[[i]] = paste("0*", covar.list[[i]], collapse = "+")
    }

    store = stringr::str_replace_all(store, stringr::fixed(" "), "")

    covars = c()
    for (i in 1:length(covar.list)) {
      covars[[i]] = sprintf("%s ~~ %s", varname[[i]], store[[i]])
    }

    covars = paste(covars, collapse = "\n")
  } else if (length(dvn) == 9) {
    varname = c(
      dvn[["p1xvarnames"]],
      dvn[["p2xvarnames"]],
      dvn[["p1yvarnames"]],
      dvn[["p2yvarnames"]]
    )
    covar.list = c()
    for (i in 1:dvn[["indnum"]]) {
      covar.list[[i]] = c(varname[i + 1:dvn[["indnum"]]])
    }
    covar.list <- covar.list[-c(dvn[["indnum"]])]
    covar.list <- lapply(covar.list, function(x) x[!is.na(x)])

    store = c()
    for (i in 1:length(covar.list)) {
      store[[i]] = paste("0*", covar.list[[i]], collapse = "+")
    }

    store = stringr::str_replace_all(store, stringr::fixed(" "), "")

    covars = c()
    for (i in 1:length(covar.list)) {
      covars[[i]] = sprintf("%s ~~ %s", varname[[i]], store[[i]])
    }

    covars = paste(covars, collapse = "\n")
  }

  #Script Creation Syntax
  if (length(dvn) == 6) {
    script = sprintf(
      "#Equated Means\n%s\n%s\n\n#Equated Variances\n%s\n%s\n\n#No Covariances\n%s",
      xints1,
      xints2,
      xvars1,
      xvars2,
      covars
    )
  } else if (length(dvn) == 9) {
    script = sprintf(
      "#Equated Means\n%s\n%s\n%s\n%s\n\n#Equated Variances\n%s\n%s\n%s\n%s\n\n#No Covariances\n%s",
      xints1,
      xints2,
      yints1,
      yints2,
      xvars1,
      xvars2,
      yvars1,
      yvars2,
      covars
    )
  }

  #Write script to file if requested
  if (!is.null(writeTo) | !is.null(fileName)) {
    #if there is a path or file name,
    #check for valid input,
    #and if valid, write script

    # checking for valid directory path and fileName
    if (!is.character(writeTo)) {
      stop(
        "The `writeout` argument must be a character string. \n Use writeTo = '.' to save script in the current working directory, for example."
      )
    }
    if (!dir.exists(writeTo)) {
      stop(
        "The specified directory does not exist. \n Use writeTo = '.' to save script in the current working directory, for example."
      )
    }
    if (!is.character(fileName)) {
      stop("The `fileName` argument must be a character string.")
    }

    #write file
    cat(script, "\n", file = sprintf("%s/%s.txt", writeTo, fileName))

    return(script)
  } else if (is.null(writeTo) & is.null(fileName)) {
    #otherwise just return script
    return(script)
  }
}