R/set_sem_layout.R

In semptools: Customizing Structural Equation Modelling Plots

#'@title Configure the layout of factors of an SEM graph by
#' [semPlot::semPaths]
#'
#'@description Configure the layout of factors and adjust other
#' aspects of an SEM graph by [semPlot::semPaths].
#'
#'@details Modify a [qgraph::qgraph] object generated by semPaths
#' based on an SEM model with latent factors. Since version 0.2.9.5,
#' this function natively supports observed exogenous variable.
#' If a variable is listed in both `indicator_order` and
#' `indicator_factor`, as if it is both a factor and an indicator,
#' this function will assume that it is an observed exogenous variable.
#' It will be positioned as a factor according to `factor_layout`,
#' but no indicators will be drawn.
#'
#' For versions older than 0.2.9.5, an observed exogenous variable
#' needs to be specified as an one-indicator factor in the model
#' specification for this function to work.
#'
#'@return A [qgraph::qgraph] based on the original one, with various
#' aspects of the model modified.
#'
#'@param semPaths_plot A [qgraph::qgraph] object generated by
#' semPaths, or a similar qgraph object modified by other [semptools]
#' functions.
#'
#'@param indicator_order A string vector of the indicators. The order
#' of the names is the order of the indicators in the graph, when they
#' are drawn on the bottom of the graph. The indicators should be
#' grouped by the factors on which they load on. For example, if x1,
#' x2, x4 load on f2, and x3, x5, x6 load on f1, then vector should be
#' either c("x1", "x2", "x4", "x3", "x5", "x6") or c("x3", "x5", "x6",
#' "x1", "x2", "x4"). Indicators within a group can be ordered in any
#' way. If it is a named vector, its names will be used for the
#' argument `indicator_factor`. If it is `NULL` (default),
#' [auto_indicator_order()] will be called to determine the
#' indicator order automatically.
#'
#'@param indicator_factor A string vector of the same length of the
#' indicator order, storing the name of the factor for which each of
#' the indicator in indicator_factor loads on. For example, if x1, x2,
#' x4 load on f2, and x3, x5, x6 load on f1, and indicator_order is
#' c("x3", "x5", "x6", "x1", "x2", "x4"), then indicator_factor should
#' be c("f2", "f2", "f2", "f1", "f1", "f1"). If `NULL`
#' (default) and `indicator_order` is a named vector (supplied
#' by users or generated by [auto_indicator_order()]), then
#' it will be set to the names of `indicator_order`.
#'
#'@param factor_layout A matrix of arbitrary size. This matrix will
#' serve as a grid for users to specify where each latent factor
#' should be placed approximately on the graph. Each cell should
#' contain NA or the name of a latent factor. The locations of all
#' latent factors must be explicitly specified by this matrix.
#'
#'@param factor_point_to Can be a named character vector with
#' names being the names of factors, or a matrix of the same size as `factor_layout`.
#' If it is a matrix,
#' this matrix specifies where the indicators of each factor are
#' positioned. Each cell should contain NA or one of these strings:
#' "down", "left", "up", or "right". This is the direction that the
#' corresponding latent factor (specified in factor_layout) points to
#' its indicators. If it is a named character vector, the
#' the values must be the directions, and the names the
#' the factors. This vector will be converted internally
#' by [auto_factor_point_to()] to create the matrix of
#' direction.
#'
#'@param indicator_push (Optional) This argument is used to adjust the
#' positions of the indicators of selected latent factors. It can be
#' named vector or a list of named lists. For a named vector, The name
#' is the factor of which the indicators will be "pushed", and the
#' value is how "hard" the push is: the multiplier to the distance
#' from the factor to the indicators. If this value is 1, then there
#' is no change. If this value is greater than 1, then the indicators
#' are pushed away from the latent factor. If this value is less than
#' 1, then the indicators are pulled toward the latent factor. For
#' example, to push the indicators of `f3` away from `f3`, and pull
#' the indicators of `f4` toward `f4`, the argument can be set to
#' `c(f3 = 1.5, f4 = .5)`. For a list of named list, each named list
#' has two named elements: `node`, the name of a latent factor, and
#' `push`, how the positions of its indicators will be adjusted. For
#' example, to have the same effect as the vector above, the list is
#' `list(list(node = "f3", push = 1.5), list(node = "f4", push =
#' .5))`.
#'
#'@param indicator_spread (Optional) This argument is used to adjust
#' the distance between indicators of selected latent factors. It can
#' be a named vector or a list of named lists. For a named vector, the
#' name is the factor of which the indicators will be spread out. The
#' value is the multiplier to the distance between neighboring
#' indicators. If this value is equal to 1, there is no change. Larger
#' than one, the indicators will be "spread" away from each other.
#' Less than one, the indicators will be placed closer to each others.
#' For example, to spread the indicators of `f1` and `f4` farther away
#' from each other, this argument can be set to `c(f1 = 2, f4 = 1.5)`,
#' with the indicators of `f1` being spread out more than those of
#' `f4`. For a list of named list, each named list has two named
#' elements: `node`, the name of a latent factor, and `spread`, how
#' the distance between indicators will be adjusted. For example, to
#' have the same effect as the vector above, the argument can be set
#' to `list(list(node = "f1", spread = 2), list(node = "f4", spread =
#' 1.5))`.
#'
#'@param loading_position (Optional) Default is .5. This is used
#' adjust the position of the loadings. If this is one single number,
#' it will be used to set the positions of all loadings. If it is .5,
#' the loadings are placed on the center of the arrows. Larger the
#' number, closer the loadings to the indicators. Smaller the number,
#' closer to the latent factors. This argument also accepts a named
#' vector or a list of named lists, allowing users to specify the
#' positions of loadings for each factor separately. For a named
#' vector, in each element, the name is the factor whose loadings will
#' be moved. The value is the positions of its loadings. The default
#' is .50. We only need to specify the positions for factors to be
#' changed from .50 to other values. For example, move the loadings of
#' `f2` closer to the indicators and those of `f4` close to the `f4`,
#' this argument can be set to `c(f2 = .7, f4 = .3)`. For a list of
#' named list, each named list should have two named elements: `node`,
#' the name of the latent factor, and `position`, the positions of all
#' loadings of this factors. To have the same effect as the vector
#' above, this list can be used: `list(list(node = "f2", position =
#' .7), list(node = "f4", position = .3))`.
#'
#'@examples
#'library(lavaan)
#'library(semPlot)
#'mod <-
#'  'f1 =~ x01 + x02 + x03
#'   f2 =~ x04 + x05 + x06 + x07
#'   f3 =~ x08 + x09 + x10
#'   f4 =~ x11 + x12 + x13 + x14
#'   f3 ~  f1 + f2
#'   f4 ~  f1 + f3
#'  '
#'fit_sem <- lavaan::sem(mod, sem_example)
#'lavaan::parameterEstimates(fit_sem)[, c("lhs", "op", "rhs", "est", "pvalue")]
#'p <- semPaths(fit_sem, whatLabels="est",
#'        sizeMan = 5,
#'        nCharNodes = 0, nCharEdges = 0,
#'        edge.width = 0.8, node.width = 0.7,
#'        edge.label.cex = 0.6,
#'        style = "ram",
#'        mar = c(10,10,10,10))
#'indicator_order  <- c("x04", "x05", "x06", "x07", "x01", "x02", "x03",
#'                      "x11", "x12", "x13", "x14", "x08", "x09", "x10")
#'indicator_factor <- c( "f2",  "f2",  "f2",  "f2",  "f1",  "f1",  "f1",
#'                      "f4",  "f4",  "f4",  "f4",  "f3",  "f3",  "f3")
#'factor_layout <- matrix(c("f1",   NA,   NA,
#'                            NA, "f3", "f4",
#'                          "f2",   NA,   NA), byrow = TRUE, 3, 3)
#'factor_point_to <- matrix(c("left",     NA,      NA,
#'                                NA, "down", "down",
#'                            "left",     NA,      NA), byrow = TRUE, 3, 3)
#'indicator_push <- c(f3 = 2, f4 = 1.5)
#'indicator_spread <- c(f1 = 2, f2 = 2)
#'loading_position <- c(f1 = .5, f2 = .8, f3 = .8)
#'# Pipe operator can be used if desired
#'p2 <- set_sem_layout(p,
#'                       indicator_order = indicator_order,
#'                       indicator_factor = indicator_factor,
#'                       factor_layout = factor_layout,
#'                       factor_point_to = factor_point_to,
#'                       indicator_push = indicator_push,
#'                       indicator_spread = indicator_spread,
#'                       loading_position = loading_position)
#'p2 <- set_curve(p2, c("f2 ~ f1" = -1,
#'                      "f4 ~ f1" = 1.5))
#'p2 <- mark_sig(p2, fit_sem)
#'p2 <- mark_se(p2, fit_sem, sep = "\n")
#'plot(p2)
#'
#'# Use a named vector for indicator_order
#'indicator_order2  <- c(f2 = "x04", f2 = "x05", f2 = "x06", f2 = "x07",
#'                       f1 = "x01", f1 = "x02", f1 = "x03",
#'                       f4 = "x11", f4 = "x12", f4 = "x13", f4 = "x14",
#'                       f3 = "x08", f3 = "x09", f3 = "x10")
#'p2 <- set_sem_layout(p,
#'                       indicator_order = indicator_order2,
#'                       factor_layout = factor_layout,
#'                       factor_point_to = factor_point_to,
#'                       indicator_push = indicator_push,
#'                       indicator_spread = indicator_spread,
#'                       loading_position = loading_position)
#'plot(p2)
#'
#'# Use automatically generated indicator_order and indicator_factor
#'p2 <- set_sem_layout(p,
#'                       factor_layout = factor_layout,
#'                       factor_point_to = factor_point_to,
#'                       indicator_push = indicator_push,
#'                       indicator_spread = indicator_spread,
#'                       loading_position = loading_position)
#'plot(p2)
#'
#'# Use named character vector for factor_point_to
#'directions <- c(f1 = "left",
#'                f2 = "left",
#'                f3 = "down",
#'                f4 = "down")
#'p2v2 <- set_sem_layout(p,
#'                       indicator_order = indicator_order,
#'                       indicator_factor = indicator_factor,
#'                       factor_layout = factor_layout,
#'                       factor_point_to = directions,
#'                       indicator_push = indicator_push,
#'                       indicator_spread = indicator_spread,
#'                       loading_position = loading_position)
#'p2v2 <- set_curve(p2v2, c("f2 ~ f1" = -1,
#'                          "f4 ~ f1" = 1.5))
#'p2v2 <- mark_sig(p2v2, fit_sem)
#'p2v2 <- mark_se(p2v2, fit_sem, sep = "\n")
#'plot(p2v2)
#'
#'#Lists of named list which are equivalent to the vectors above:
#'#indicator_push <- list(list(node = "f3", push =   2),
#'#                       list(node = "f4", push =   1.5))
#'#indicator_spread <- list(list(node = "f1", spread =   2),
#'#                         list(node = "f2", spread =   2))
#'#loading_position <- list(list(node = "f1", position = .5),
#'#                         list(node = "f2", position = .8),
#'#                         list(node = "f3", position = .8))
#'
#'@export

set_sem_layout <- function(semPaths_plot,
                             indicator_order = NULL,
                             indicator_factor = NULL,
                             factor_layout = NULL,
                             factor_point_to = NULL,
                             indicator_push = NULL,
                             indicator_spread = NULL,
                             loading_position = .5) {
    if (is.null(indicator_order)) {
        check_node_label_string(semPaths_plot$graphAttributes$Nodes$labels)
        indicator_order <- auto_indicator_order(semPaths_plot,
                                                 add_isolated_manifest = TRUE)
        # stop("indicator_order not specified.")
      }
    if (is.null(indicator_factor)) {
        if (!is.null(names(indicator_order))) {
            indicator_factor <- names(indicator_order)
          } else {
            indicator_order <- tryCatch(lavaan_indicator_order(indicator_order),
                                         error = function(e) e)
            if (inherits(indicator_factor, "error")) {
                stop("indicator_factor not specified or cannot be determined.")
              }
            indicator_factor <- names(indicator_order)
          }
      }
    if (is.null(factor_layout)) {
        stop("factor_layout not specified.")
      }
    if (is.null(factor_point_to)) {
        stop("factor_point_to 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.")
          }
      }

    tmp <- add_manifest(factor_layout = factor_layout,
                        indicator_order = indicator_order,
                        indicator_factor = indicator_factor)
    indicator_order <- tmp$indicator_order
    indicator_factor <- tmp$indicator_factor

    if (!is.matrix(factor_point_to) && is.vector(factor_point_to)) {
        factor_point_to <- auto_factor_point_to(factor_layout,
                                                factor_point_to)
      }

    Nodes_names <- semPaths_plot$graphAttributes$Nodes$names
    if (!is.null(names(Nodes_names))) {
        Nodes_names <- names(Nodes_names)
        Nodes_names2 <- semPaths_plot$graphAttributes$Nodes$names
      } else {
        Nodes_names2 <- NA
      }

    if (!all(Nodes_names[semPaths_plot$graphAttributes$Nodes$shape == "square"] %in% indicator_order)) {
        if (!all(Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "square"] %in% indicator_order)) {
            tmp1 <- Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "square"]
            tmp2 <- indicator_order
            msg_tmp <- setdiff(tmp1,
                               indicator_order)
            msg_tmp <- paste(unlist(msg_tmp),
                             collapse = ", ")
            warning("One or more indicators in the graph are not in indicator_order. Unexpected results may occur. ",
                    "Indicator(s) involved: ",
                    msg_tmp)
          } else {
            tmp <- sapply(indicator_order, function(x) {
                Nodes_names[match(x, Nodes_names2)]
              }, USE.NAMES = FALSE)
            indicator_order <- tmp
          }
      }
    if (!all(Nodes_names[semPaths_plot$graphAttributes$Nodes$shape == "circle"] %in% indicator_factor)) {
        if (!all(Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "circle"] %in% indicator_factor)) {
            warning("One or more factors in the graph are not in indicator_factor. Unexpected results may occur.")
          } else {
            tmp <- sapply(indicator_factor, function(x) {
                Nodes_names[match(x, Nodes_names2)]
              }, USE.NAMES = FALSE)
            indicator_factor <- tmp
          }
      }

    # Nodes_names <- semPaths_plot$graphAttributes$Nodes$names
    # if (!is.null(names(Nodes_names))) {
    #   Nodes_names <- names(Nodes_names)
    # }
    # if (!all(Nodes_names[semPaths_plot$graphAttributes$Nodes$shape == "square"] %in% indicator_order)) {
    #     warning("One or more indicators in the graph may not be in indicator_order. Unexpected results may occur.")
    #   }
    # if (!all(Nodes_names[semPaths_plot$graphAttributes$Nodes$shape == "circle"] %in% indicator_factor)) {
    #     warning("One or more factors in the graph may not be in indicator_factor. Unexpected results may occur.")
    #   }
    if (!all(indicator_factor %in% factor_layout[!is.na(factor_layout)])) {
        if (!all(Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "circle"] %in%
                 factor_layout[!is.na(factor_layout)])) {
            tmp <- Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "circle"]
            msg_tmp <- setdiff(tmp,
                               factor_layout[!is.na(factor_layout)])
            msg_tmp <- paste(unlist(msg_tmp),
                             collapse = ", ")
            stop("The position of one or more latent factors are not in factor_layout. ",
                 "Factor(s) involved: ",
                 msg_tmp)
          } else {
            tmp <- sapply(factor_layout, function(x) {
                Nodes_names[match(x, Nodes_names2)]
              }, USE.NAMES = FALSE)
            factor_layout[] <- tmp
          }
      }

    # Record "indicators" of 2nd order factors to NA
    tmp <- unique(indicator_factor)
    tmp2 <- indicator_factor == indicator_order
    if (any(tmp2)) {
        # Remove manifest variables treated as factors
        tmp <- setdiff(tmp, unique(indicator_factor[tmp2]))
      }
    indicator_order_original <- indicator_order
    indicator_order[indicator_order %in% tmp] <- NA

    if (!all((!is.na(factor_layout) & !(factor_layout %in% indicator_order)) ==
               !is.na(factor_point_to))) {
        tmp1 <- !is.na(factor_layout) & !(factor_layout %in% indicator_order)
        tmp2 <- !is.na(factor_point_to)
        msg_tmp <- as.vector(factor_layout[tmp1 != tmp2])
        msg_tmp <- paste(unlist(msg_tmp),
                         collapse = ", ")
        stop("The positions of the indicators of one or more latent factors are not specified in factor_point_to. ",
             "Factor(s) involved: ",
             msg_tmp)
      }

    # Set the estate

    factor_order <- unique(indicator_factor)

    layout_nrow <- nrow(factor_layout)
    layout_ncol <- ncol(factor_layout)

    factor_coord <- t(sapply(factor_order, function(x) {
                              which(factor_layout == x, arr.ind = TRUE)
                            }, USE.NAMES = TRUE))
    factor_coord_point_to <- sapply(factor_order, function(x) {
                              factor_point_to[factor_coord[x, 1],
                                              factor_coord[x, 2]]
                            }, USE.NAMES = TRUE)
    indicator_grouped <- split(indicator_order, indicator_factor)
    position_grouped <- sapply(indicator_grouped, function(x) {
                              out <- seq(-1, 1, length.out = length(x) + 2)
                              out <- out[-1]
                              out <- out[-length(out)]
                              out
                            }, simplify = FALSE, USE.NAMES = TRUE)

    factor_coord2y <- -1*(2*(factor_coord[, 1]*2 - 1)/(2*layout_nrow) - 1)
    factor_coord2x <- 2*(factor_coord[, 2]*2 - 1)/(2*layout_ncol) - 1
    box_width  <- 2/layout_ncol
    box_height <- 2/layout_nrow
    factor_order <- factor_order[!(factor_order %in% indicator_order)]

    set_indicator_xy <- function(x,
                                 position_grouped,
                                 factor_coord_point_to,
                                 factor_coord2x,
                                 factor_coord2y,
                                 box_width,
                                 box_height,
                                 indicator_push,
                                 indicator_spread) {
        position_grouped_i <- position_grouped[[x]]
        factor_coord_point_to_i <- factor_coord_point_to[x]
        factor_coord2x_i <- factor_coord2x[x]
        factor_coord2y_i <- factor_coord2y[x]
        if (is.null(indicator_push)) {
            indicator_push_i <- 1
          } else {

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

            tmp <- sapply(indicator_push,
              function(y, node) {ifelse(y$node == node, y$push, NA)}, node = x)
            indicator_push_i <- tmp[!is.na(tmp)]
            if (length(indicator_push_i) == 0) indicator_push_i <- 1
          }
        if (is.null(indicator_spread)) {
            indicator_spread_i <- 1
          } else {

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

            tmp <- sapply(indicator_spread,
              function(y, node) {ifelse(y$node == node, y$spread, NA)}, node = x)
            indicator_spread_i <- tmp[!is.na(tmp)]
            if (length(indicator_spread_i) == 0) indicator_spread_i <- 1
          }
        k <- length(position_grouped_i)
        position_grouped_x <-
          position_grouped_i * (indicator_spread_i*box_width/2) +
                                factor_coord2x_i
        position_grouped_y <-
          position_grouped_i * (indicator_spread_i*box_height/2) +
                                factor_coord2y_i
        if (factor_coord_point_to_i == "down") {
            position_grouped_x <- position_grouped_x
            position_grouped_y <- rep(factor_coord2y_i -
                                      (indicator_push_i*box_height/2), k)
          } else if (factor_coord_point_to_i == "up") {
            position_grouped_x <- position_grouped_x
            position_grouped_y <- rep(factor_coord2y_i +
                                      (indicator_push_i*box_height/2), k)
          } else if (factor_coord_point_to_i == "left") {
            position_grouped_x <- rep(factor_coord2x_i -
                                      (indicator_push_i*box_width/2), k)
            position_grouped_y <- position_grouped_y
          } else if (factor_coord_point_to_i == "right") {
            position_grouped_x <- rep(factor_coord2x_i +
                                      (indicator_push_i*box_width/2), k)
            position_grouped_y <- position_grouped_y
          }
        list(position_grouped_x = position_grouped_x,
             position_grouped_y = position_grouped_y)
      }
    indicator_xy <- sapply(factor_order, set_indicator_xy,
                             position_grouped = position_grouped,
                             factor_coord_point_to = factor_coord_point_to,
                             factor_coord2x = factor_coord2x,
                             factor_coord2y = factor_coord2y,
                             box_width = box_width,
                             box_height = box_height,
                             indicator_push = indicator_push,
                             indicator_spread = indicator_spread,
                             simplify = FALSE)
    spread_indicator_xy_i <- function(x, indicator_xy, indicator_grouped) {
                                data.frame(node = indicator_grouped[[x]],
                                 x = indicator_xy[[x]]$position_grouped_x,
                                 y = indicator_xy[[x]]$position_grouped_y)
                             }
    spread_indicator_xy <- sapply(factor_order, spread_indicator_xy_i,
                             indicator_xy = indicator_xy,
                             indicator_grouped = indicator_grouped,
                             simplify = FALSE)
    spread_indicator_xy <- do.call(rbind, spread_indicator_xy)
    spread_factor_xy <- data.frame(node = names(factor_coord2y),
                                      x = factor_coord2x,
                                      y = factor_coord2y)
    Nodes_xy <- rbind(spread_indicator_xy, spread_factor_xy)

    original_layout <- semPaths_plot$layout
    i <- match(Nodes_names, Nodes_xy$node)
    new_layout <- original_layout
    new_layout[, 1] <- Nodes_xy$x[i]
    new_layout[, 2] <- Nodes_xy$y[i]
    semPaths_plot$layout <- new_layout

    # Fix the residual
    indicator_order_latent <- indicator_order[!(indicator_order %in% indicator_factor)]
    indicator_factor_latent <- indicator_factor[!(indicator_factor %in% indicator_order)]

    residual_rotate <- lapply(seq_len(length(indicator_order_latent)),
            function(x, indicator_order,
                        indicator_factor,
                        factor_coord_point_to) {
                list(node = indicator_order[x],
                     rotate = switch(factor_coord_point_to[indicator_factor[x]],
                                up    =   0,
                                right =  90,
                                down  = 180,
                                left  = -90))
              }, indicator_order = indicator_order_latent,
                 indicator_factor = indicator_factor_latent,
                 factor_coord_point_to = factor_coord_point_to)
    tmp <- sapply(residual_rotate, function(x) !is.na(x$node))
    residual_rotate <- residual_rotate[tmp]
    semPaths_plot <- rotate_resid(semPaths_plot, residual_rotate)

    factor_coord_point_to_latent <- factor_coord_point_to[!(names(factor_coord_point_to) %in% indicator_order)]
    factor_residual_rotate <- lapply(names(factor_coord_point_to_latent),
          function(x, factor_coord_point_to) {
                list(node = x,
                     rotate = switch(factor_coord_point_to[x],
                                up    = 180,
                                right = -90,
                                down  =   0,
                                left  =  90))
              }, factor_coord_point_to = factor_coord_point_to_latent)
    semPaths_plot <- rotate_resid(semPaths_plot, factor_residual_rotate)

    # Position the loadings

    if ((length(loading_position) == 1) & (is.numeric(loading_position))) {
        loading_position_list <-
            (Nodes_names[semPaths_plot$Edgelist$from] %in% factor_order) &
            (Nodes_names[semPaths_plot$Edgelist$to] %in% indicator_order) &
                         !semPaths_plot$Edgelist$bidirectional
        semPaths_plot$graphAttributes$Edges$edge.label.position[loading_position_list] <- loading_position
      } else {

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

        loading_label_position <- lapply(seq_len(length(loading_position)),
                function(x, loading_position,
                            indicator_grouped) {
                     node <- loading_position[[x]]$node
                     position <- loading_position[[x]]$position
                     out <- lapply(indicator_grouped[[node]],
                                function(y, node, position) {
                                    list(from = node,
                                           to = y,
                                           new_position = position)
                                  }, node = node, position = position
                              )
                     out
                  }, loading_position = loading_position,
                     indicator_grouped = indicator_grouped)
        loading_label_position <- do.call(c, loading_label_position)
        semPaths_plot <- set_edge_label_position(semPaths_plot,
                                                 loading_label_position)
      }

    # Force all arrows from factors to indicators to be straight
    tmp <- !(indicator_order_original == indicator_factor)
    tmp[is.na(indicator_order)] <- TRUE
    i_o_1 <- indicator_order_original[tmp]
    i_f_1 <- indicator_factor[tmp]
    tmp2 <- paste0(i_o_1, " ~ ", i_f_1)
    tmp3 <- stats::setNames(vector(mode = "numeric", length(tmp2)), tmp2)
    semPaths_plot <- set_curve(semPaths_plot, tmp3)

    semPaths_plot
  }