R/set_edge_label_position.R

In semptools: Customizing Structural Equation Modelling Plots

#'@title Set the positions of edge labels of selected edges
#'
#'@description  Set the positions of edge labels of selected edges.
#'
#'@details Modify a [qgraph::qgraph] object generated by
#' [semPlot::semPaths] and change the edge label positions of selected
#' edges.
#'
#'@return A [qgraph::qgraph] based on the original one, with edge
#' label positions for selected edges changed.
#'
#'@param semPaths_plot A [qgraph::qgraph] object generated by
#' [semPlot::semPaths], or a similar qgraph object modified by other
#' [semptools] functions.
#'
#'@param position_list A named vector or a list of named lists. For a
#' named vector, the name of an element should be the path as
#' specified by [lavaan::model.syntax] or as appeared in
#' [lavaan::parameterEstimates()]. For example, to change position of
#' the edge label of the path regressing `y` on `x`, the name should
#' be `"y ~ x"`. The value is the position. The mid-point of the edge
#' is 0.5. The closer the value to 1, the closer the label to the
#' left-hand-side node (`y` in this example). The closer the value to
#' 0, the close the label to the right-hand-side node (`x` in this
#' example). For example, `c("y ~ x1" = .2, "y ~ x2" = .7)` moves the
#' path coefficient from `x1` to `y` closer to `x`, and the path
#' coefficient from `x2` to `y` closer to `y`. For a list of named
#' lists, each named list should have three named values: `from`,
#' `to`, and `new_position`. The edge label position of the edge from
#' `from` to `to` will be set to `new_position`. For example,
#' `list(list(from = "x1", to = "y", new_position = .2), list(from =
#' "x2", to = "y", new_position = .7))` is equivalent to the named
#' vector above.
#'
#'@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_position_vector <- c("x3 ~ x2" = .25,
#'                        "x4 ~ x1" = .75)
#'p_pa2v <- set_edge_label_position(p_pa, my_position_vector)
#'plot(p_pa2v)
#'
#'my_position_list <- list(list(from = "x2", to = "x3", new_position =  .25),
#'                        list(from = "x1", to = "x4", new_position =  .75))
#'p_pa2l <- set_edge_label_position(p_pa, my_position_list)
#'plot(p_pa2l)
#'
#'@export

set_edge_label_position <- function(semPaths_plot, position_list = NULL) {
    if (is.null(position_list)) {
        stop("position_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(position_list) && is.numeric(position_list)) {
        position_list_org <- position_list
        position_list <- to_list_of_lists(position_list,
                                       name1 = "from",
                                       name2 = "to",
                                       name3 = "new_position")
      }

    Nodes_names <- semPaths_plot$graphAttributes$Nodes$names
    Nodes_id <- seq_len(length(Nodes_names))
    names(Nodes_id) <- Nodes_names
    position_old <- semPaths_plot$graphAttributes$Edges$edge.label.position
    position_new <- position_old
    position_index <- sapply(position_list, function(x) {
          edge_index(semPaths_plot, from = x$from, to = x$to)
        })
    position_new[position_index] <- sapply(position_list, function(x) x$new_position)
    semPaths_plot$graphAttributes$Edges$edge.label.position <- position_new
    semPaths_plot
  }