Merge pull request #140 from sfcheung/devel

0.2.9.25: Add an article for models with both lv and observed ivs
sfcheung · Oct 15, 2023 · 5c67d5a · 5c67d5a
2 parents 108b958 + 213a615
commit 5c67d5a
Show file tree

Hide file tree

Showing 16 changed files with 2,262 additions and 38 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -7,4 +7,5 @@
 ^.*\.Rproj$
 ^\.Rproj\.user$
 ^\.github$
-^pkgdown$
+^pkgdown$
+^\.lintr$
diff --git a/.lintr b/.lintr
@@ -0,0 +1,3 @@
+linters: linters_with_defaults(
+    indentation_linter = NULL
+  )
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: semptools
 Title: Customizing Structural Equation Modelling Plots
-Version: 0.2.9.19
+Version: 0.2.9.25
 Authors@R: c(
     person(given = "Shu Fai",
            family = "Cheung",

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# semptools 0.2.9.19
+# semptools 0.2.9.25
 
 - Added an R CMD check for noSuggests. (0.2.9.12)
 - Fixed `set_cfa_layout()` to work for
@@ -15,19 +15,34 @@
 - Fixed a bug in the setting for `pkgdown`. (0.2.9.16)
 - Add `DoNotPlot = TRUE` in all tests to
   prevent `semPlot::semPaths()` from
-  plotting the graphs in the tests. (0.2.9.17)
+  plotting the graphs in the tests. (0.2.9.17, 0.2.9.20)
 - Added `auto_indicator_order()` and
   `lavaan_indicator_order()` for setting
   indicator order in `set_sem_layout()`
-  and `set_cfa_layout()`. (0.2.9.18)
+  and `set_cfa_layout()`. Can handle
+  nodes with labels changed. (0.2.9.18, 0.2.9.24)
 - Revised `set_cfa_layout()` and
   `set_sem_layout()` to set
   `indicator_order` and
   `indicator_factor` automatically if
-  not supplied. (0.2.9.18)
+  not supplied. Node labels must be
+  string for this option to work. (0.2.9.18, 0.2.9.23)
 - Added the helper `add_object()`. (0.2.9.18)
 - Removed `dplyr` functions from the code
-  and removed `dplyr` from `Imports`. (0.2.9.19)`
+  and removed `dplyr` from `Imports`. (0.2.9.19)
+- Removed the check for factors with
+  no direction specified in `auto_factor_point_to()`.
+  The "factor" may be a manifest variable without
+  indicators. (0.2.9.20)
+- Fixed a bug in `auto_factor_point_to()`:
+  Cells with no direction specified is now
+  set to `NA`. (0.2.9.21)
+- Added two internal helpers to check
+  node labels (labels changed?
+  labels non-string?). (0.2.9.22)
+- Added an `pkgdown` articles on setting
+  the layout for a model with both latent
+  factors and exogenous observed variables. (0.2.9.25)
 
 
 # semptools 0.2.9.11

diff --git a/R/auto_factor_point_to.R b/R/auto_factor_point_to.R
@@ -79,18 +79,19 @@ auto_factor_point_to <- function(factor_layout,
     fnames <- as.vector(factor_layout)
     fnames <- fnames[!is.na(fnames)]
     tmp <- setdiff(fnames, args_names)
-    if (length(tmp) != 0) {
-        stop("Direction not specified for factor(s) ",
-             paste(tmp, collapse = ", "),
-             ".")
-      }
+    # if (length(tmp) != 0) {
+    #     stop("Direction not specified for factor(s) ",
+    #          paste(tmp, collapse = ", "),
+    #          ".")
+    #   }
     tmp <- setdiff(unlist(args),
                    valid_directions)
     if (length(tmp) != 0) {
         stop("Invalid direction: ",
              paste(tmp, collapse = ", "))
       }
     out <- factor_layout
+    out[] <- NA
     out_c <- col(out)
     out_r <- row(out)
     for (i in seq_along(args)) {

diff --git a/R/helpers.R b/R/helpers.R
@@ -48,12 +48,12 @@ loading_plot <- function(semPaths_plot,
     if (add_isolated_manifest) {
         # Isolated manifest variables
         id2 <- !(man_id %in% edges2$to)
-        iso_man <- nodes$names[id2]
+        iso_man <- unlist(nodes$names)[id2]
       } else {
         iso_man <- NULL
       }
-    edges3$lhs <- nodes$names[edges3$to]
-    edges3$rhs <- nodes$names[edges3$from]
+    edges3$lhs <- unlist(nodes$names)[edges3$to]
+    edges3$rhs <- unlist(nodes$names)[edges3$from]
     edges4 <- edges3[!duplicated(edges3$lhs), ]
     out <- c(edges4$lhs, iso_man)
     names(out) <- c(edges4$rhs, iso_man)
@@ -76,4 +76,40 @@ add_manifest <- function(factor_layout,
     out <- list(indicator_order = indicator_order,
                 indicator_factor = indicator_factor)
     return(out)
-  }
+  }
+
+#' @noRd
+
+check_node_label_string <- function(x) {
+    chk <- sapply(x, is.character)
+    if (!all(chk)) {
+        msg <- paste("Not all labels are strings.",
+                     "Please set labels after applying this function.")
+        tmp <- paste(names(x)[!chk], collapse = ", ")
+        msg <- paste(msg,
+                     "Node(s) with non-string label(s):",
+                     tmp)
+        stop(msg)
+      } else {
+        return(TRUE)
+      }
+  }
+
+#' @noRd
+
+check_node_label_changed <- function(x) {
+    check_node_label_string(x)
+    chk <- names(x) == unlist(x)
+    if (!all(chk)) {
+        msg <- paste("Not all nodes have labels identical to node names.",
+                     "Please set labels after applying this function,",
+                     "and please set nCharNodes = 0 when calling semPaths().")
+        tmp <- paste(names(x)[!chk], collapse = ", ")
+        msg <- paste(msg,
+                     "Node(s) with changed/shortened label(s):",
+                     tmp)
+        stop(msg)
+      } else {
+        return(TRUE)
+      }
+  }
diff --git a/R/set_cfa_layout.R b/R/set_cfa_layout.R
@@ -120,6 +120,7 @@ set_cfa_layout <- function(semPaths_plot,
                              loading_position = .5,
                              point_to = "down") {
     if (is.null(indicator_order)) {
+        check_node_label_string(semPaths_plot$graphAttributes$Nodes$labels)
         indicator_order <- auto_indicator_order(semPaths_plot)
         # stop("indicator_order not specified.")
       }

diff --git a/R/set_sem_layout.R b/R/set_sem_layout.R
@@ -231,6 +231,7 @@ set_sem_layout <- function(semPaths_plot,
                              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.")

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.19, updated on 2023-10-14, [release history](https://sfcheung.github.io/semptools/news/index.html))
+(Version 0.2.9.25, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html))
 
 # semptools <img src="man/figures/logo.png" align="right" height="150" />
 

diff --git a/_pkgdown.yml b/_pkgdown.yml
@@ -17,19 +17,48 @@ template:
   includes:
     in_header: <meta name="google-site-verification" content="0VLBmFnW_UJFI-7gXnORPBsWxqZwmzuGpK-TeVRLBjQ" />
 
+# navbar:
+#   bg: primary
+
+# articles:
+# - title: Articles
+#   navbar: ~
+#   contents:
+#   - semptools
+#   - quick_start_cfa
+#   - quick_start_sem
+#   - keep_or_drop_nodes
+#   - layout_matrix
+#   - second_order
+
 navbar:
   bg: primary
-
-articles:
-- title: Articles
-  navbar: ~
-  contents:
-  - semptools
-  - quick_start_cfa
-  - quick_start_sem
-  - keep_or_drop_nodes
-  - layout_matrix
-  - second_order
+  structure:
+    left:  [intro, articles, reference, tutorials, news]
+    right: [search, github]
+  components:
+    articles:
+      text: Articles
+      menu:
+      - text: "<Quick Starts>"
+      - text: Main functions
+        href: articles/semptools.html
+      - text: Setting the layout of a CFA model
+        href: articles/quick_start_cfa.html
+      - text: Setting the layout of a SEM model
+        href: articles/quick_start_sem.html
+      - text: -------
+      - text: "<Helpers>"
+      - text: Keep or drop variables
+        href: articles/keep_or_drop_nodes.html
+      - text: Layout matrices
+        href: articles/layout_matrix.html
+      - text: -------
+      - text: "<Special Cases>"
+      - text: Second-order factors
+        href: articles/second_order.html
+      - text: Observed exogenous variables
+        href: articles/sem_with_observed.html
 
 reference:
 - title: Main Functions

diff --git a/tests/testthat/test-auto_point_to.R b/tests/testthat/test-auto_point_to.R
@@ -52,20 +52,20 @@ test_that("auto_point_to", {
                      factor_point_to_v2)
     expect_identical(factor_point_to,
                      factor_point_to_v3)
-    expect_error(auto_factor_point_to(factor_layout,
-                                      f1 = "left",
-                                      f3 = "down",
-                                      f4 = "down"),
-                 "f2")
+    # expect_error(auto_factor_point_to(factor_layout,
+    #                                   f1 = "left",
+    #                                   f3 = "down",
+    #                                   f4 = "down"),
+    #              "f2")
     expect_error(auto_factor_point_to(factor_layout,
                                       f1 = "left",
                                       f2 = "Hello",
                                       f3 = "down",
                                       f4 = "down"),
                  "Hello")
-    expect_error(auto_factor_point_to(factor_layout,
-                                      fd[-2]),
-                 "f3")
+    # expect_error(auto_factor_point_to(factor_layout,
+    #                                   fd[-2]),
+    #              "f3")
     fd2 <- fd
     fd2[1] <- "Hello"
     expect_error(auto_factor_point_to(factor_layout,

diff --git a/tests/testthat/test-change-node.R b/tests/testthat/test-change-node.R
@@ -173,7 +173,8 @@ p_cfa <- semPaths(fit,
   node.width = 1,
   edge.label.cex = .75,
   style = "ram",
-  mar = c(10, 5, 10, 5)
+  mar = c(10, 5, 10, 5),
+  DoNotPlot = TRUE
 )
 
 my_label_list <- list(
@@ -234,7 +235,8 @@ p_sem <- semPaths(fit_sem,
   edge.width = 0.8, node.width = 0.7,
   edge.label.cex = 0.6,
   style = "ram",
-  mar = c(10, 10, 10, 10)
+  mar = c(10, 10, 10, 10),
+  DoNotPlot = TRUE
 )
 p_sem2 <- change_node_label(p_sem, my_label_list)
 

diff --git a/tests/testthat/test-set_sem_layout_single.R b/tests/testthat/test-set_sem_layout_single.R
@@ -72,3 +72,51 @@ test_that("Layout as expected after change_node_label", {
       e2_layout
     )
   })
+
+# Use auto
+
+mod <-
+  'f1 =~ x01 + x02 + x03
+   f3 =~ x08 + x09 + x10
+   f4 =~ x11 + x12 + x13 + x14
+   f3 ~ f1 + x04
+   f4 ~ f3 + x05'
+fit_sem <- lavaan::sem(mod, sem_example)
+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,
+        mar = c(10,10,10,10),
+        DoNotPlot = TRUE)
+factor_layout <- layout_matrix(f1 = c(1, 1),
+                               f3 = c(1, 2),
+                               f4 = c(1, 3),
+                               x04 = c(2, 1),
+                               x05 = c(2, 2))
+factor_point_to <- auto_factor_point_to(factor_layout,
+                                        f1 = "left",
+                                        f3 = "up",
+                                        f4 = "right")
+indicator_push <- c(f3 = 2, f4 = 1.5)
+indicator_spread <- c(f1 = 2)
+loading_position <- c(f3 = .8)
+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)
+e_layout <- structure(
+    c(-1, -1, -1, -0.166666666666667, 0, 0.166666666666667,
+      -0.666666666666667, 1.16666666666667, 1.16666666666667, 1.16666666666667,
+      1.16666666666667, 0, -0.666666666666667, 0, 0.666666666666667,
+      0, 0.5, 1, 1.5, 1.5, 1.5, -0.5, 0.2, 0.4, 0.6, 0.8, -0.5, 0.5,
+      0.5, 0.5), .Dim = c(15L, 2L)
+  )
+test_that("Layout as expected", {
+    expect_equal(
+      p2$layout,
+      e_layout
+    )
+  })