R/auto_layout.R

In semptools: Customizing Structural Equation Modelling Plots

#' @title Set the Layout of a Mediation
#' Model Automatically
#'
#' @description Set the layout of
#' variables in a mediation model in the
#' typical left-to-right style
#' automatically.
#'
#' @details
#' Typically, a path model with some
#' `x` variables, some `y` variables,
#' and some mediators are drawn from
#' left to right. This function tries
#' to generate the layout matrix
#' automatically, meeting the following
#' requirements:
#'
#' - The predictor(s), `x` variables(x),
#'   is/are placed to the left.
#'
#' - The outcome variable(s), `y`
#'   variable(s), is/are placed to the
#'   right.
#'
#' - The mediator(s) are positioned
#'   between `x` variable(s) and `y`
#'   variable(s) such that all paths
#'   point to the right. That is,
#'   no vertical path.
#'
#' - The vertical position(s) of the
#'   mediator(s) will be adjusted such
#'   that no path passes through a
#'   mediator. That is, all paths are
#'   visible and not blocked by any
#'   mediator.
#'
#' @return
#'
#' If `object` is a `lavaan`-class
#' object, or if `update_plot` is `FALSE`,
#' it returns
#' a two-dimension layout matrix of the
#' position of the nodes, or a
#' two-column matrix of the x-y positions
#' of the nodes, depending on the
#' argument `output`.
#'
#' If `object` is a `qgraph` object
#' and `update_plot` is `TRUE`, it
#' returns a `qgraph` object with the
#' the modified layout.
#'
#' @param object It can be the output of
#' [lavaan::sem()] or
#' [lavaan::lavaan()], or a
#' `lavaan`-class object. The model must
#' have a `beta` matrix of the
#' structural path. It can also be a
#' `qgraph` object generated by
#' [semPlot::semPaths()]. A `beta``
#' matrix will be reconstructed from the
#' graph.
#'
#' @param x The variables that will be
#' treated as (pure) `x` variables:
#' placed on the left of the plot, with
#' no variables predicting them. If
#' `NULL`, the default, the `x`
#' variable(s) will be identified
#' automatically.
#'
#' @param y The variables that will be
#' treated as (pure) `y` variables:
#' placed on the right of the plot, with
#' no variables predicted by them. If
#' `NULL`, the default, the `y`
#' variable(s) will be identified
#' automatically.
#'
#' @param exclude The variables to be
#' omitted from the plot, typically the
#' covariates ("control variables") in a
#' model. If `NULL`, the default, all
#' variables involved in the structural
#' paths will be used in the plot. It
#' is possible to exclude `y`-variables.
#' However, excluding mediators is not
#' allowed.
#'
#' @param v_pos How the mediators are to
#' be positioned vertically in the
#' first pass. If
#' `"middle"`, the function will try to
#' position them close to the center of
#' the plot. If `"lower"`, it will try
#' to position them to the lower part of
#' the plot. If `"upper"`, it will try
#' to position them to the upper part of
#' the plot.
#'
#' @param v_preference The preference in
#' shifting the mediators upward
#' (`"upper"`) or downward (`"lower"`)
#' in the second pass to avoid blocking
#' or overlapping with any paths in the
#' models. It is used only when`v_pos`
#' is `"middle"`. If `v_pos` is
#' `"lower"`, then `v_preference` will
#' be forced to be `"lower". If `v_pos`
#' is `"upper"`, then `v_preference`
#' will be forced to be `"upper".
#'
#' @param output The format of the
#' output, used if `update_plot` is
#' `FALSE`. If `"matrix"`, the output is
#' a two-dimension character matrix with
#' the names of the variables. If
#' `"xy"`, the output is a two-column
#' matrix of the relatived x- and
#' y-positions of each variables.
#'
#' @param update_plot Logical. Used
#' if `object` is a `qgraph` object. If
#' `TRUE`, the function returns a
#' modified `qgraph` object with the
#' new layout. If `FALSE`
#'
#' @seealso [set_sem_layout()]. The
#' output of [auto_layout_mediation()]
#' can be used by [set_sem_layout()].
#'
#' @examples
#'
#' library(lavaan)
#' library(semPlot)
#'
#' # Create a dummy dataset
#' mod_pa <-
#' "
#' m11 ~ c1 + x1
#' m21 ~ c2 + m11
#' m2 ~ m11 + c3
#' m22 ~ m11 + c3
#' y ~ m2 + m21 + m22 + x1
#' "
#' fit <- lavaan::sem(
#'           mod_pa,
#'           do.fit = FALSE
#'         )
#' dat <- simulateData(
#'           parameterTable(fit),
#'           sample.nobs = 500,
#'           seed = 1234
#'         )
#' fit <- lavaan::sem(
#'           mod_pa,
#'           dat
#'         )
#'
#' # Set the layout
#' m <- auto_layout_mediation(
#'         fit,
#'         exclude = c("c1", "c2", "c3")
#'       )
#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2", "c3"))
#' semPaths(
#'           pm,
#'           whatLabels = "est",
#'           layout = m
#'         )
#'
#' # v_pos = "lower"
#' m <- auto_layout_mediation(
#'         fit,
#'         exclude = c("c1", "c2", "c3"),
#'         v_pos = "lower"
#'       )
#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2", "c3"))
#' p0 <- semPaths(
#'           pm,
#'           whatLabels = "est",
#'           layout = m
#'         )
#'
#' # v_pos = "upper"
#' m <- auto_layout_mediation(
#'         fit,
#'         exclude = c("c1", "c2", "c3"),
#'         v_pos = "upper"
#'       )
#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2", "c3"))
#' p0 <- semPaths(
#'           pm,
#'           whatLabels = "est",
#'           layout = m
#'         )
#'
#' # Can modify a qgraph
#'
#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2", "c3"))
#' p <- semPaths(
#'           pm,
#'           whatLabels = "est"
#'         )
#' p2 <- auto_layout_mediation(p)
#' plot(p2)
#'
#'
#'
#' @export

auto_layout_mediation <- function(
                            object,
                            x = NULL,
                            y = NULL,
                            exclude = NULL,
                            v_pos = c("middle", "lower", "upper"),
                            v_preference = c("upper", "lower"),
                            output = c("matrix", "xy"),
                            update_plot = TRUE
                          ) {
  v_pos <- match.arg(v_pos)
  v_preference <- match.arg(v_preference)
  output <- match.arg(output)

  object_type <- NA
  if (inherits(object, "lavaan")) {
    object_type <- "lavaan"
    if (lavaan::lavTech(object, "ngroups") != 1) {
      stop("Multigroup models not supported.")
    }
    beta0 <- lavaan::lavInspect(
                object,
                what = "free"
              )$beta
    if (is.null(beta0)) {
      stop("The model has no structural paths. Is it a CFA model?")
    }
  } else if (inherits(object, "qgraph")) {
    object_type <- "qgraph"
    if (has_intercept(object)) {
      stop("Does not support a plot with intercept(s).")
    }
    if (is_multigroup_qgraph(object)) {
      stop("Does not support multigroup plot.")
    }
    # Cannot check for factor loading
    # paths because there is no way to
    # differentiate a path from a latent
    # factor to an observed outcome
    # variable from a factor loading
    # path.
    beta0 <- qgraph_to_beta(object)
  } else {
    stop("object is not a supported type.")
  }
  beta1 <- fixed_beta(
              beta0,
              x = x,
              y = y,
              exclude = exclude
            )
  c_list <- column_list(beta1)
  m0 <- c_list_to_layout(
              c_list,
              v_pos = v_pos
            )
  m1 <- fix_mxy(
            m = m0,
            beta = beta1,
            v_preference = v_preference
          )
  if ((object_type == "qgraph") &&
      update_plot) {
    object_layout <- qgraph_to_layoutxy(object)
    m2 <- m1[rownames(object_layout), ]
    m2 <- rescale_layout_matrix(m2)
    out <- object
    out$layout <- m2
    out <- make_straight(out)
  } else {
    out <- switch(output,
                matrix = layout_matrix_from_mxy(m1),
                xy = m1)
  }
  out
}