0.3.1.10: Bug fix: m may be unnecessarily moved in auto_layout

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: semptools
 Title: Customizing Structural Equation Modelling Plots
-Version: 0.3.1.9
+Version: 0.3.1.10
 Authors@R: c(
     person(given = "Shu Fai",
            family = "Cheung",

NEWS.md

@@ -1,4 +1,4 @@
-# semptools 0.3.1.9
+# semptools 0.3.1.10
 
 ## New Features
 
@@ -13,7 +13,7 @@
   generating a layout matrix automatically.
   It can also update an exist plot of
   `semPlot::semPaths()`.
-  (0.3.1.5, 0.3.1.9)
+  (0.3.1.5, 0.3.1.9, 0.3.1.10)
 
 - Added `safe_edge_label_position()` to
   reposition edge labels away from the

R/auto_layout.R

@@ -273,8 +273,6 @@ auto_layout_mediation <- function(
           )
   if ((object_type == "qgraph") &&
       update_plot) {
-    # TODO:
-    # - Force all directed path to be a straight line
     object_layout <- qgraph_to_layoutxy(object)
     m2 <- m1[rownames(object_layout), ]
     m2 <- rescale_layout_matrix(m2)

R/auto_layout_helpers.R

@@ -181,6 +181,17 @@ fix_mxy <- function(
     m_i <- mnames[m[, "x"] == i]
     x_i <- mnames[m[, "x"] < i]
     y_i <- mnames[m[, "x"] > i]
+    tmp <- which(colnames(beta) %in% m_i)
+    beta_tmp <- beta[-tmp, -tmp]
+    x_beta <- beta_tmp[, x_i, drop = FALSE]
+    y_beta <- beta_tmp[y_i, , drop = FALSE]
+    x_i <- colnames(x_beta)[colSums(x_beta) > 0]
+    y_i <- rownames(y_beta)[rowSums(y_beta) > 0]
+    if ((length(x_i) == 0) ||
+        (length(y_i) == 0)) {
+      # No paths through m_i
+      next
+    }
     lines_i <- all_lines(
                   m = m_new,
                   from = x_i,

R/safe_edge_label_positions.R

@@ -83,10 +83,10 @@
 #' mod_pa <-
 #' "
 #' m11 ~ c1 + x1
-#' m21 ~ c2 + m11
-#' m2 ~ m11 + c3
-#' m22 ~ m11 + c3
-#' y ~ m2 + m21 + m22 + x1
+#' m12 ~ c2 + m11 + m21
+#' m21 ~ c1 + x1
+#' m22 ~ c1 + m21 + m11
+#' y ~ m12 + m22 + x1
 #' "
 #' fit <- lavaan::sem(
 #'           mod_pa,
@@ -106,26 +106,24 @@
 #'         fit,
 #'         exclude = c("c1", "c2", "c3")
 #'       )
-#'
 #' pos_new <- safe_edge_label_position(
 #'                 fit,
 #'                 layout = m
 #'               )
 #' pos_new
-#'
-#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2", "c3"))
+#' pm <- semPlotModel(fit) |> drop_nodes(c("c1", "c2"))
 #' p <- semPaths(
 #'           pm,
 #'           whatLabels = "est",
 #'           layout = m,
 #'           DoNotPlot = TRUE
 #'         )
+#' # Three labels overlap with each other
 #' plot(p)
-#'
 #' # Update the plot
 #' p_safe <- p |> safe_edge_label_position()
+#' # Three labels do not overlap in this plot
 #' plot(p_safe)
-#'
 #' # Set the position manually
 #' p_safe2 <- p |>
 #'             set_edge_label_position(pos_new)

README.md

@@ -9,7 +9,7 @@
 [![R-CMD-check](https://github.com/sfcheung/semptools/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/sfcheung/semptools/actions/workflows/R-CMD-check.yaml)
 <!-- badges: end -->
 
-(Version 0.3.1.9, updated on 2025-07-06, [release history](https://sfcheung.github.io/semptools/news/index.html))
+(Version 0.3.1.10, updated on 2025-07-06, [release history](https://sfcheung.github.io/semptools/news/index.html))
 
 # semptools <img src="man/figures/logo.png" align="right" height="150" />
 

tests/testthat/test-auto_layout_mediation.R

@@ -68,38 +68,68 @@ m <- auto_layout_mediation(
       )
 
 m_chk <- structure(c("c1", NA, "c3", NA, "x2", NA, "x1", NA, NA, NA, "x3",
-NA, NA, NA, NA, "x4", NA, NA, NA, NA, NA, NA, NA, NA, "x5", NA,
+NA, NA, NA, NA, NA, NA, "x4", NA, NA, NA, NA, NA, NA, "x5", NA,
 NA, NA), dim = c(7L, 4L))
 
 expect_equal(m,
              m_chk)
 
+# pm <- semPlotModel(fit) |> drop_nodes(c("y", "c2"))
+# p0 <- semPaths(
+#           pm,
+#           whatLabels = "est",
+#           layout = m,
+#           exoCov = FALSE,
+#           DoNotPlot = TRUE
+#         )
+# plot(p0)
+
 m <- auto_layout_mediation(
         fit,
         v_pos = "lower"
       )
 
 m_chk <- structure(c("c2", NA, "c1", NA, "c3", NA, "x2", NA, "x1", NA,
-NA, NA, NA, NA, "x3", NA, NA, NA, NA, NA, NA, NA, NA, "x4", NA,
+NA, "x3", NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, "x4", NA,
 NA, NA, NA, NA, NA, "x5", NA, NA, NA, NA, NA, "y", NA, NA, NA,
 NA, NA, NA, NA, NA), dim = c(9L, 5L))
 
 expect_equal(m,
              m_chk)
 
+# pm <- semPlotModel(fit)
+# p0 <- semPaths(
+#           pm,
+#           whatLabels = "est",
+#           layout = m,
+#           exoCov = FALSE,
+#           DoNotPlot = TRUE
+#         )
+# plot(p0)
+
 m <- auto_layout_mediation(
         fit,
         v_pos = "upper"
       )
 
 m_chk <- structure(c("c2", NA, "c1", NA, "c3", NA, "x2", NA, "x1", NA,
-NA, NA, "x3", NA, NA, NA, NA, NA, NA, NA, NA, "x4", NA, NA, NA,
+NA, NA, NA, NA, NA, "x3", NA, NA, NA, NA, NA, "x4", NA, NA, NA,
 NA, NA, NA, NA, NA, NA, NA, "x5", NA, NA, NA, NA, NA, NA, NA,
 NA, NA, NA, NA, "y"), dim = c(9L, 5L))
 
 expect_equal(m,
              m_chk)
 
+# pm <- semPlotModel(fit)
+# p0 <- semPaths(
+#           pm,
+#           whatLabels = "est",
+#           layout = m,
+#           exoCov = FALSE,
+#           DoNotPlot = TRUE
+#         )
+# plot(p0)
+
 expect_error(auto_layout_mediation(
         fit,
         exclude = c("x4")

tests/testthat/test-auto_layout_mediation_middle.R

@@ -0,0 +1,59 @@
+library(lavaan)
+library(semPlot)
+
+test_that("auto_layout_mediation", {
+
+mod_pa <-
+ 'm1 ~ x
+  m21 ~ m1
+  m22 ~ m1
+  m3 ~ m21 + m22
+  y ~ m3
+ '
+
+fit <- lavaan::sem(
+          mod_pa,
+          do.fit = FALSE
+        )
+dat <- simulateData(
+          parameterTable(fit),
+          sample.nobs = 500,
+          seed = 1234
+        )
+fit <- lavaan::sem(
+          mod_pa,
+          dat
+        )
+
+p0 <- semPaths(
+          fit,
+          whatLabels = "est",
+          DoNotPlot = TRUE
+        )
+p1 <- auto_layout_mediation(p0)
+# plot(p1)
+
+beta0 <- qgraph_to_beta(p0)
+beta1 <- fixed_beta(
+              beta0,
+              x = "x",
+              y = "y",
+            )
+c_list <- column_list(beta1)
+m0 <- c_list_to_layout(
+            c_list
+          )
+m1 <- fix_mxy(
+          m = m0,
+          beta = beta1
+        )
+m1
+
+m1_chk <- structure(c(1, 2, 3, 3, 4, 5, 0, 0, -0.5, 0.5, 0, 0), dim = c(6L,
+2L), dimnames = list(c("x", "m1", "m21", "m22", "m3", "y"), c("x",
+"y")), v_pos = "middle")
+
+expect_equal(m1,
+             m1_chk)
+
+})

tests/testthat/test-safe_edge_label_positions.R

@@ -49,8 +49,8 @@ if (length(pos_new) > 0) {
               pos_new
             )
 }
-pos_chk <- c(0.5, 0.5, 0.275, 0.275, 0.5, 0.5, 0.275, 0.5, 0.275, 0.5, 0.5,
-0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5)
+pos_chk <- c(0.5, 0.725, 0.275, 0.275, 0.5, 0.5, 0.275, 0.5, 0.725, 0.5,
+0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5)
 
 expect_equal(p2$graphAttributes$Edges$edge.label.position,
              pos_chk)