R/set_node_attribute.R

In semptools: Customizing Structural Equation Modelling Plots

#' @title Set the Attributes of Selected Nodes
#'
#' @description Set arbitrary attributes
#' of selected nodes
#'
#' @details Modify a [qgraph::qgraph]
#' object generated by
#' [semPlot::semPaths] and change the
#' selected attributes of selected
#' nodes.
#'
#' This function is designed to be a
#' general one that changes the
#' attributes named by the user. The
#' user needs to make sure that the
#' attribute actually exists, and the
#' values are valid for the named
#' attribute.
#'
#' ## Setting the value of `values`
#'
#' This argument can be set in two ways.
#'
#' For a named vector, the name of an
#' element should be the nodes for which
#' their attributes are to be changed.
#' The names need to the *displayed*
#' *names* if plotted, which may be
#' different from the names in mode.
#'
#' For example, if the attributes to be
#' changed are the colors of selected
#' nodes, to change the color of `x`
#' is to be changed, the name
#' should be `"x"`. Therefore,
#' `c("y" = "red", "x" = "red")` changes
#' the colors of the nodes `y` and `x`
#' to `"red"` and `"blue"`,
#' respectively.
#'
#' For a list of named lists, each named
#' list should have two named values:
#' `node` and `new_value`. The
#' attribute of `node`
#' will be set to `new_value`.
#'
#' The second approach is no longer
#' recommended, though kept for backward
#' compatibility.
#'
#' @return A [qgraph::qgraph] based on
#' the original one, with the selected
#' attributes of selected nodes changed.
#'
#' @param semPaths_plot A
#' [qgraph::qgraph] object generated by
#' [semPlot::semPaths], or a similar
#' qgraph object modified by other
#' [semptools] functions.
#'
#' @param values A named vector or a
#' list of named list. See the Details
#' section on how to set this argument.
#'
#' @param attribute_name The name of
#' the attribute to be changed.
#'
#' @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_color_vector <- c(x3 = "red", x4 = "blue")
#'
#' p_pa2v <- set_node_attribute(p_pa, my_color_vector, attribute_name = "color")
#' plot(p_pa2v)
#'
#' my_color_list <- list(list(node = "x3", new_value = "green"),
#'                       list(node = "x4", new_value = "red"))
#'
#' p_pa2l <- set_node_attribute(p_pa, my_color_list, attribute_name = "color")
#' plot(p_pa2l)
#'
#' @export

set_node_attribute <- function(semPaths_plot,
                               values = NULL,
                               attribute_name = NULL) {

    if (is.null(values)) {
        stop("values not specified.")
      }
    if (is.null(attribute_name)) {
        stop("attribute_name 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.")
          }
      }

    # Convert a named vector to a named list
    if (!is.list(values)) {
        values_org <- values
        values <- to_list_of_lists(values,
                                   name1 = "node",
                                   name2 = "new_value")
      }

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

    p <- n_nodes(semPaths_plot)
    attr_old <- semPaths_plot$graphAttributes$Nodes[[attribute_name]]
    if (is.null(attr_old)) {
        stop("attribute_name not a valid attribute of the npdes a qgraph object.")
      }

    # Expand if necessary
    if (isTRUE(length(attr_old) == 1)) {
        attr_old <- rep(attr_old, p)
      }

    attr_new <- attr_old
    attr_new[Nodes_id[Nodes_in]] <- sapply(values,
                                           function(x) x$new_value)
    semPaths_plot$graphAttributes$Nodes[[attribute_name]] <- attr_new
    semPaths_plot
  }

#' @title The number of nodes
#' @noRd

n_nodes <- function(object) {
    object$graphAttributes$Graph$nNodes
  }