Merge pull request #143 from sfcheung/devel

0.2.9.28: Make some error messages and warnings more informative

DESCRIPTION

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

NEWS.md

@@ -1,4 +1,4 @@
-# semptools 0.2.9.25
+# semptools 0.2.9.28
 
 - Added an R CMD check for noSuggests. (0.2.9.12)
 - Fixed `set_cfa_layout()` to work for
@@ -43,6 +43,11 @@
 - Added an `pkgdown` articles on setting
   the layout for a model with both latent
   factors and exogenous observed variables. (0.2.9.25)
+- Removed the mention of `change_node_label2`,
+  which was not exported, from the help page. (0.2.9.26, 0.2.9.27)
+- Made the warning and error messages of
+  `set_cfa_layout()` and `set_sem_layout()`
+  more informative. (0.2.9.28)
 
 
 # semptools 0.2.9.11

R/change_node_label.R

@@ -5,8 +5,6 @@
 #'@details Modify a [qgraph::qgraph] object generated by
 #' [semPlot::semPaths] and change the labels of selected nodes.
 #'
-#' \code{change_node_label2()} is an experimental version that takes a
-#' named list as input.
 #.
 #'
 #'@return A [qgraph::qgraph] based on the original one, with node
@@ -195,6 +193,11 @@ change_node_label <- function(semPaths_plot, label_list = NULL,
     semPaths_plot
   }
 
+# \code{change_node_label2()} is an experimental version that takes a
+# named list as input.
+# SF (2023-10-15): This function is not exported and so no need to document it.
+#' @noRd
+
 change_node_label2 <- function(semPaths_plot, label_list = NULL) {
   if (is.null(label_list)) {
     rlang::abort("label_list not specified.")

R/set_cfa_layout.R

@@ -166,7 +166,13 @@ set_cfa_layout <- function(semPaths_plot,
              %in% indicator_order)) {
         if (!all(Nodes_names2[semPaths_plot$Edgelist$to[!semPaths_plot$Edgelist$bidirectional]]
               %in% indicator_order)) {
-            warning("One or more indicators in the graph are not in indicator_order. Unexpected results may occur.")
+            msg_tmp <- setdiff(Nodes_names2[semPaths_plot$Edgelist$to[!semPaths_plot$Edgelist$bidirectional]],
+                               indicator_order)
+            msg_tmp <- paste(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)]

R/set_sem_layout.R

@@ -283,7 +283,15 @@ set_sem_layout <- function(semPaths_plot,
 
     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)) {
-            warning("One or more indicators in the graph are not in indicator_order. Unexpected results may occur.")
+            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)]
@@ -312,10 +320,17 @@ set_sem_layout <- function(semPaths_plot,
     # 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(factor_layout[!is.na(factor_layout)] %in% indicator_factor)) {
-        if (!all(factor_layout[!is.na(factor_layout)] %in%
-              Nodes_names2[semPaths_plot$graphAttributes$Nodes$shape == "circle"])) {
-            stop("The position of one or more latent factors are not in factor_layout.")
+    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)]
@@ -336,7 +351,14 @@ set_sem_layout <- function(semPaths_plot,
 
     if (!all((!is.na(factor_layout) & !(factor_layout %in% indicator_order)) ==
                !is.na(factor_point_to))) {
-        stop("The positions of the indicators of one or more latent factors are not specified in 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

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.25, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html))
+(Version 0.2.9.28, 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" />
 

tests/testthat/test-set_cfa_layout_error_warning.R

@@ -0,0 +1,36 @@
+library(lavaan)
+library(semPlot)
+
+# CFA
+
+mod <-
+  'factor1 =~ 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("x4", "x05", "x06", "x07",
+                      "x01", "x02", "x03",
+                      "x11", "x12", "x13", "x14",
+                      "x08", "x09", "x10")
+indicator_factor <- c( "f2",  "f2",  "f2",  "f2",
+                       "factor1",  "factor1",  "factor1",
+                       "f4",  "f4",  "f4",  "f4",
+                       "f3",  "f3",  "f3")
+
+test_that("set_cfa_layout: Not all indicators in the vectors", {
+    expect_warning({p2 <- set_cfa_layout(p,
+                                         indicator_order,
+                                         indicator_factor)},
+                   "x04")
+  })

tests/testthat/test-set_sem_layout_error_warning.R

@@ -0,0 +1,85 @@
+library(lavaan)
+library(semPlot)
+mod <-
+  'factor1 =~ x01 + x02 + x03
+   f2 =~ x04 + x05 + x06 + x07
+   f3 =~ x08 + x09 + x10
+   f4 =~ x11 + x12 + x13 + x14
+   f3 ~  factor1 + f2
+   f4 ~  factor1 + 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,
+        nCharEdges = 0,
+        edge.width = 0.8, node.width = 0.7,
+        edge.label.cex = 0.6,
+        mar = c(10,10,10,10),
+        DoNotPlot = TRUE)
+p2 <- change_node_label(p, list(list(node = "fc1", to = "iv1"),
+                                list(node = "f3", to = "Mediator"),
+                                list(node = "f4", to = "dv"),
+                                list(node = "x01", to = "Test Item")))
+indicator_order  <- c("x04", "x05", "x06", "x07", "Test Item", "x02", "x03",
+                      "x11", "x12", "x13", "x14", "x08", "x09", "x10")
+indicator_factor <- c( "f2",  "f2",  "f2",  "f2",  "iv1",  "iv1",  "iv1",
+                      "dv",  "dv",  "dv",  "dv",  "Mediator",  "Mediator",  "Mediator")
+factor_layout <- matrix(c("iv1",   NA,   NA,
+                            NA, "Mediator", "dv",
+                          "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 <- list(list(node = "Mediator", push =   2),
+                       list(node = "dv", push =   1.5))
+indicator_spread <- list(list(node = "iv1", spread =   2),
+                         list(node = "f2", spread =   2))
+loading_position <- list(list(node = "iv1", position = .5),
+                         list(node = "f2", position = .8),
+                         list(node = "Mediator", position = .8))
+
+p3 <- set_sem_layout(p2,
+                       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)
+p3 <- set_curve(p3, list(list(from = "iv1", to = "f2", new_curve =  -1),
+                         list(from = "iv1", to = "dv", new_curve = 1.5)))
+
+
+factor_layout_wrong <- matrix(c(  NA,   NA,   NA,
+                                  NA, "Mediator", "dv",
+                                "f2",   NA,   NA), byrow = TRUE, 3, 3)
+
+factor_point_to_wrong <- matrix(c("left",     NA,      NA,
+                                NA, NA, NA,
+                                "left",     NA,      NA), byrow = TRUE, 3, 3)
+
+indicator_factor_wrong <- gsub("iv1", "f2", indicator_factor)
+
+
+test_that(
+  "set_sem_layout: More informative error/warning", {
+    expect_error(set_sem_layout(p2,
+                       indicator_order = indicator_order,
+                       indicator_factor = indicator_factor,
+                       factor_layout = factor_layout_wrong,
+                       factor_point_to = factor_point_to),
+                 "iv1")
+    expect_error(set_sem_layout(p2,
+                       indicator_order = indicator_order,
+                       indicator_factor = indicator_factor,
+                       factor_layout = factor_layout,
+                       factor_point_to = factor_point_to_wrong),
+                 "f3, f4")
+    expect_warning(set_sem_layout(p2,
+                       indicator_order = indicator_order[-c(1, 5)],
+                       indicator_factor = indicator_factor[-c(1, 5)],
+                       factor_layout = factor_layout,
+                       factor_point_to = factor_point_to),
+                 "Test Item, x04")
+  })