R/move_node.R

In semptools: Customizing Structural Equation Modelling Plots

#' @title Move Nodes in a Plot
#'
#' @description Move the nodes in an
#' plot generated by [semPlot::semPaths()].
#'
#' @details Modify a [qgraph::qgraph]
#' object generated by
#' [semPlot::semPaths] and move selected
#' nodes.
#'
#' The change assumes that the layout
#' is defined with 0 as the center,
#' -1 to 1 from left to right, and
#' from bottom to top.
#'
#' @return A [qgraph::qgraph] based on
#' the original one, with the selected
#' nodes moved.
#'
#' @param semPaths_plot A
#' [qgraph::qgraph] object generated by
#' [semPlot::semPaths], or a similar
#' qgraph object modified by other
#' [semptools] functions.
#'
#' @param move_by A named list. The
#' names are the names of nodes to be
#' moved. Each element of the list can
#' be either a named numeric vector or
#' an unnamed vector of two numbers. If
#' a named vector, `x` is the horizontal
#' change in the position (e.g., .25
#' means moving to the right by .25, and
#' -.5 means moving to the left by .5),
#' and `y` is the vertical change (e.g.,
#' .5 means moving up by .5, and -.1
#' means moving down by .1). If unnamed,
#' then the vector must have two numbers,
#' the first for the horizontal move (`x`)
#' and the second for the vertical move.
#' The value is interpreted based on
#' the unit of the plot, usually from
#' -1 to 1 for `x` and `y`, with 0 being
#' the center of the plot.
#'
#' @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)
#'
#' p_changed <- move_node(p_pa,
#'                        list(x3 = c(x = -.25, y = -.25),
#'                             x4 = c(y = .5)))
#' plot(p_changed)
#'
#' @export

move_node <- function(
              semPaths_plot,
              move_by = NULL) {

    if (is.null(move_by)) {
        stop("values not specified.")
      }
    if (missing(semPaths_plot)) {
        stop("semPaths_plot not specified.")
      } else {
        if (!inherits(semPaths_plot, "qgraph")) {
            stop("semPaths_plot is not a qgraph object.")
          }
      }

    # Check nodes
    Nodes_in <- names(move_by)
    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 not in semPaths_plot.")
      }
    Nodes_id <- seq_len(length(Nodes_names))
    names(Nodes_id) <- Nodes_names

    layout_org <- qgraph_to_layoutxy(semPaths_plot)

    layout_new <- layout_org
    for (x in names(move_by)) {
      move_by_i <- move_by[[x]]
      if (is.null(names(move_by_i))) {
        new_x <- move_by_i[1]
        new_y <- move_by_i[2]
      } else {
        new_x <- move_by_i["x"]
        new_y <- move_by_i["y"]
      }
      if (!is.na(new_x)) {
        layout_new[Nodes_id[x], "x"] <- layout_new[Nodes_id[x], "x"] + new_x
      }
      if (!is.na(new_y)) {
        layout_new[Nodes_id[x], "y"] <- layout_new[Nodes_id[x], "y"] + new_y
      }
    }

    layout_final <- layout_new
    rownames(layout_final) <- colnames(layout_final) <- NULL
    semPaths_plot$layout <- layout_final

    semPaths_plot
  }