R/rotate_resid.R

In semptools: Customizing Structural Equation Modelling Plots

#'@title Rotate the residuals of selected nodes
#'
#'@description Rotate the residuals of selected nodes.
#'
#'@details Modify a [qgraph::qgraph] object generated by
#'  [semPlot::semPaths] and rotate the residuals of selected nodes.
#'  Currently only supports "ram" and similar styles of
#'  [semPlot::semPaths].
#'
#'@return A [qgraph::qgraph] object based on the original one, with
#' `loopRotation` attributes of selected nodes modified.
#'
#'@param semPaths_plot A [qgraph::qgraph] object generated by
#' [semPlot::semPaths], or a similar qgraph object modified by other
#' [semptools] functions.
#'
#'@param rotate_resid_list A named vector or a list of named list. For
#'  a named vector, the name of an element is the node for which its
#'  residual is to be rotated, and the value is the degree to rotate.
#'  The 12 o'clock position is zero degree. Positive degree denotes
#'  clockwise rotation, and negative degree denotes anticlockwise
#'  rotation. For example, `c(x3 = 45, x4 = -45)` means rotating the
#'  residual of `x3` 45 degrees clockwise, and rotating the residual
#'  of `x4` 45 degrees anticlockwise. For a list of named lists, each
#'  named list should have two named values: `node` and `rotate`. The
#'  position of the residual of \code{node} will be placed at
#'  \code{rotate}, in degree. For example, `list(list(node = "x3",
#'  rotate =  45), list(node = "x4", rotate = -45))` is equivalent to
#'  `c(x3 = 45, x4 = -45)`.
#'
#'@examples
#'mod_pa <-
#'  'x1 ~~ x2
#'   x3 ~  x1 + x2
#'   x4 ~  x1 + x3
#'  '
#'fit_pa <- lavaan::sem(mod_pa, pa_example)
#'lavaan::parameterEstimates(fit_pa)[, c("lhs", "op", "rhs", "est", "pvalue")]
#'m <- matrix(c("x1",   NA,   NA,
#'                NA, "x3", "x4",
#'              "x2",   NA,   NA), byrow = TRUE, 3, 3)
#'p_pa <- semPlot::semPaths(fit_pa, whatLabels="est",
#'            style = "ram",
#'            nCharNodes = 0, nCharEdges = 0,
#'            layout = m)
#'
#'my_rotate_resid_vector <- c(x3 = 45, x4 = -45)
#'
#'p_pa2v <- rotate_resid(p_pa, my_rotate_resid_vector)
#'plot(p_pa2v)
#'
#'my_rotate_resid_list <- list(list(node = "x3", rotate =  45),
#'                          list(node = "x4", rotate = -45))
#'
#'p_pa2l <- rotate_resid(p_pa, my_rotate_resid_list)
#'plot(p_pa2l)
#'
#'@export

rotate_resid <- function(semPaths_plot, rotate_resid_list = NULL) {
    if (is.null(rotate_resid_list)) {
        stop("rotate_resid_list not specified.")
      }
    if (is.null(semPaths_plot)) {
        stop("semPaths_plot not specified.")
      } else {
        if (!inherits(semPaths_plot, "qgraph")) {
            stop("semPaths_plot is not a qgraph object.")
          }
      }

    # Convert a named vector to a named list
    if (!is.list(rotate_resid_list) && is.numeric(rotate_resid_list)) {
        rotate_resid_list_org <- rotate_resid_list
        rotate_resid_list <- to_list_of_lists(rotate_resid_list,
                                              name1 = "node",
                                              name2 = "rotate")
      }

    Nodes_in <- sapply(rotate_resid_list, function(x) x$node)
    Nodes_names <- semPaths_plot$graphAttributes$Nodes$names
    if (!is.null(names(Nodes_names))) {
      Nodes_names <- names(Nodes_names)
    }
    if (!all(Nodes_in %in% Nodes_names)) {
        stop("One or more nodes in rotate_resid_list not in semPaths_plot.")
      }
    Nodes_id <- seq_len(length(Nodes_names))
    names(Nodes_id) <- Nodes_names
    loopRotation_old <- semPaths_plot$graphAttributes$Nodes$loopRotation
    loopRotation_new <- loopRotation_old
    loopRotation_new[Nodes_id[Nodes_in]] <- sapply(rotate_resid_list,
                                                    function(x) x$rotate*pi/180)
    semPaths_plot$graphAttributes$Nodes$loopRotation <- loopRotation_new
    semPaths_plot
  }