Merge pull request #130 from sfcheung/devel

0.9.1.14: set_cfa_layout() works with exoCov = FALSE
sfcheung · Oct 13, 2023 · 2f61e26 · 2f61e26
2 parents ac258aa + c8a2d05
commit 2f61e26
Show file tree

Hide file tree

Showing 6 changed files with 98 additions and 6 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: semptools
 Title: Customizing Structural Equation Modelling Plots
-Version: 0.2.9.13
+Version: 0.2.9.14
 Authors@R: c(
     person(given = "Shu Fai",
            family = "Cheung",

diff --git a/NEWS.md b/NEWS.md
@@ -1,8 +1,12 @@
-# semptools 0.2.9.13
+# semptools 0.2.9.14
 
 - Added an R CMD check for noSuggests. (0.2.9.12)
 - Fixed `set_cfa_layout()` to work for
   LISREL-style graphs. (0.2.9.13)
+- Fixed `set_cfa_layout()` to work for
+  a model without factor covariances
+  (e.g., `exoCov = FALSE` when calling
+  `semPlot::semPaths()`). (0.2.9.14)
 
 # semptools 0.2.9.11
 

diff --git a/R/edge_index.R b/R/edge_index.R
@@ -23,6 +23,10 @@ edge_index <- function(semPaths_plot, from, to) {
         # Check the names of Nodes_names
         out <- which(semPaths_plot$Edgelist$from == Nodes_id2[from] &
                      semPaths_plot$Edgelist$to == Nodes_id2[to])
-        return(out)
+        if (length(out) > 0) {
+            return(out)
+          } else {
+            return(NA)
+          }
       }
   }
diff --git a/R/set_cfa_layout.R b/R/set_cfa_layout.R
@@ -227,12 +227,18 @@ set_cfa_layout <- function(semPaths_plot,
                                           to = fcov$rhs,
                                          MoreArgs =
                                            list(semPaths_plot = semPaths_plot))
-      curve_new[curve_index] <- -1*fcov$curve
+      curve_index <- curve_index[!is.na(curve_index)]
+      if (length(curve_index) > 0) {
+          curve_new[curve_index] <- -1*fcov$curve
+        }
       curve_index <- mapply(edge_index, from = fcov$rhs,
                                           to = fcov$lhs,
                                          MoreArgs =
                                            list(semPaths_plot = semPaths_plot))
-      curve_new[curve_index] <- fcov$curve
+      curve_index <- curve_index[!is.na(curve_index)]
+      if (length(curve_index) > 0) {
+          curve_new[curve_index] <- fcov$curve
+        }
       semPaths_plot$graphAttributes$Edges$curve <- curve_new
       }
 

diff --git a/README.md b/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.2.9.13, updated on 2023-10-13, [release history](https://sfcheung.github.io/semptools/news/index.html))
+(Version 0.2.9.14, updated on 2023-10-13, [release history](https://sfcheung.github.io/semptools/news/index.html))
 
 # semptools <img src="man/figures/logo.png" align="right" height="150" />
 

diff --git a/tests/testthat/test-set_cfa_layou_orthogonal.R b/tests/testthat/test-set_cfa_layou_orthogonal.R
@@ -0,0 +1,78 @@
+library(lavaan)
+library(semPlot)
+
+# CFA
+
+mod <-
+  'f1 =~ x01 + x02 + x03
+   f2 =~ x04 + x05 + x06 + x07
+   f3 =~ x08 + x09 + x10
+   f4 =~ x11 + x12 + x13 + x14
+  '
+fit <- lavaan::cfa(mod, cfa_example, orthogonal = TRUE)
+p <- semPaths(fit,
+              whatLabels = "est",
+              sizeMan = 3.25,
+              node.width = 1,
+              edge.label.cex = .75,
+              mar = c(10, 5, 10, 5),
+              exoCov = FALSE,
+              DoNotPlot = TRUE)
+#plot(p)
+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")
+
+test_that("Orthogonal", {
+    expect_no_error({p2 <- set_cfa_layout(p,
+                                          indicator_order,
+                                          indicator_factor)})
+  })
+
+# SEM
+
+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 <- lavaan::sem(mod, cfa_example)
+p <- semPaths(fit,
+              whatLabels = "est",
+              sizeMan = 5,
+              node.width = 1,
+              edge.label.cex = .75,
+              exoCov = FALSE,
+              mar = c(5, 5, 5, 5),
+              DoNotPlot = TRUE)
+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 <- layout_matrix(f1 = c(1, 1),
+                               f2 = c(3, 1),
+                               f3 = c(2, 2),
+                               f4 = c(2, 3))
+factor_point_to <- layout_matrix(left = c(1, 1),
+                                 left = c(3, 1),
+                                 down = c(2, 2),
+                                 down = c(2, 3))
+test_that("Orthogonal", {
+    expect_no_error({p2 <- set_sem_layout(p,
+                     indicator_order = indicator_order,
+                     indicator_factor = indicator_factor,
+                     factor_layout = factor_layout,
+                     factor_point_to = factor_point_to)})
+  })