From 3b871ed5688ec911b73835aac555c6c4a9cfea6d Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 15 Oct 2023 18:59:08 +0800 Subject: [PATCH 1/5] 0.2.9.26: Removed the mention of change_node_label2() --- DESCRIPTION | 2 +- NEWS.md | 4 +++- R/change_node_label.R | 9 ++++++--- README.md | 2 +- man/change_node_label.Rd | 3 --- 5 files changed, 11 insertions(+), 9 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index dc97eb7..3636825 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: semptools Title: Customizing Structural Equation Modelling Plots -Version: 0.2.9.25 +Version: 0.2.9.26 Authors@R: c( person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index 1603386..88e3882 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# semptools 0.2.9.25 +# semptools 0.2.9.26 - Added an R CMD check for noSuggests. (0.2.9.12) - Fixed `set_cfa_layout()` to work for @@ -43,6 +43,8 @@ - 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) # semptools 0.2.9.11 diff --git a/R/change_node_label.R b/R/change_node_label.R index 0f66713..3091a1b 100644 --- a/R/change_node_label.R +++ b/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 @@ -192,9 +190,14 @@ change_node_label <- function(semPaths_plot, label_list = NULL, semPaths_plot$plotOptions$label.norm <- label.norm } - semPaths_plot + semPaths_plotj } +# \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.") diff --git a/README.md b/README.md index 1bc34b3..e57995d 100644 --- 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) -(Version 0.2.9.25, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html)) +(Version 0.2.9.26, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html)) # semptools diff --git a/man/change_node_label.Rd b/man/change_node_label.Rd index 9fe56b1..5effc8f 100644 --- a/man/change_node_label.Rd +++ b/man/change_node_label.Rd @@ -61,9 +61,6 @@ Change the labels of selected nodes. \details{ Modify a \link[qgraph:qgraph]{qgraph::qgraph} object generated by \link[semPlot:semPaths]{semPlot::semPaths} and change the labels of selected nodes. - -\code{change_node_label2()} is an experimental version that takes a -named list as input. } \examples{ library(semPlot) From 509250e05c9acad7d46c3df93b199b045d251f67 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 15 Oct 2023 19:10:42 +0800 Subject: [PATCH 2/5] Fix a typo --- R/change_node_label.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/change_node_label.R b/R/change_node_label.R index 3091a1b..a6a59e4 100644 --- a/R/change_node_label.R +++ b/R/change_node_label.R @@ -190,7 +190,7 @@ change_node_label <- function(semPaths_plot, label_list = NULL, semPaths_plot$plotOptions$label.norm <- label.norm } - semPaths_plotj + semPaths_plot } # \code{change_node_label2()} is an experimental version that takes a From ae9e816d80ae596e7dc0cc697efa7514bf5eccdb Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 15 Oct 2023 19:13:33 +0800 Subject: [PATCH 3/5] Update to 0.2.9.27 --- DESCRIPTION | 2 +- NEWS.md | 4 ++-- README.md | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3636825..a928dc8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: semptools Title: Customizing Structural Equation Modelling Plots -Version: 0.2.9.26 +Version: 0.2.9.27 Authors@R: c( person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index 88e3882..027bccc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# semptools 0.2.9.26 +# semptools 0.2.9.27 - Added an R CMD check for noSuggests. (0.2.9.12) - Fixed `set_cfa_layout()` to work for @@ -44,7 +44,7 @@ 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) + which was not exported, from the help page. (0.2.9.26, 0.2.9.27) # semptools 0.2.9.11 diff --git a/README.md b/README.md index e57995d..b88773c 100644 --- 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) -(Version 0.2.9.26, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html)) +(Version 0.2.9.27, updated on 2023-10-15, [release history](https://sfcheung.github.io/semptools/news/index.html)) # semptools From b832ae710bf89cf65d4184f5ae9fc4cdf699bbf6 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 15 Oct 2023 19:19:12 +0800 Subject: [PATCH 4/5] Fix a typo in file name --- ...et_cfa_layou_orthogonal.R => test-set_cfa_layout_orthogonal.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{test-set_cfa_layou_orthogonal.R => test-set_cfa_layout_orthogonal.R} (100%) diff --git a/tests/testthat/test-set_cfa_layou_orthogonal.R b/tests/testthat/test-set_cfa_layout_orthogonal.R similarity index 100% rename from tests/testthat/test-set_cfa_layou_orthogonal.R rename to tests/testthat/test-set_cfa_layout_orthogonal.R From 477b41bb9816a1bc47727dbdcbb9c8dffb7040c1 Mon Sep 17 00:00:00 2001 From: Shu Fai Cheung Date: Sun, 15 Oct 2023 20:14:20 +0800 Subject: [PATCH 5/5] 0.2.9.28: Make some error messages and warnings more informative Tests, checks, build_site() passed. --- DESCRIPTION | 2 +- NEWS.md | 5 +- R/set_cfa_layout.R | 8 +- R/set_sem_layout.R | 34 ++++++-- README.md | 2 +- .../test-set_cfa_layout_error_warning.R | 36 ++++++++ .../test-set_sem_layout_error_warning.R | 85 +++++++++++++++++++ 7 files changed, 162 insertions(+), 10 deletions(-) create mode 100644 tests/testthat/test-set_cfa_layout_error_warning.R create mode 100644 tests/testthat/test-set_sem_layout_error_warning.R diff --git a/DESCRIPTION b/DESCRIPTION index a928dc8..54cc1cb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: semptools Title: Customizing Structural Equation Modelling Plots -Version: 0.2.9.27 +Version: 0.2.9.28 Authors@R: c( person(given = "Shu Fai", family = "Cheung", diff --git a/NEWS.md b/NEWS.md index 027bccc..affedac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,4 @@ -# semptools 0.2.9.27 +# semptools 0.2.9.28 - Added an R CMD check for noSuggests. (0.2.9.12) - Fixed `set_cfa_layout()` to work for @@ -45,6 +45,9 @@ 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 diff --git a/R/set_cfa_layout.R b/R/set_cfa_layout.R index e795456..4555d46 100644 --- a/R/set_cfa_layout.R +++ b/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)] diff --git a/R/set_sem_layout.R b/R/set_sem_layout.R index 14c7c58..a115563 100644 --- a/R/set_sem_layout.R +++ b/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 diff --git a/README.md b/README.md index b88773c..6bd8be1 100644 --- 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) -(Version 0.2.9.27, 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 diff --git a/tests/testthat/test-set_cfa_layout_error_warning.R b/tests/testthat/test-set_cfa_layout_error_warning.R new file mode 100644 index 0000000..ea76ff8 --- /dev/null +++ b/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") + }) diff --git a/tests/testthat/test-set_sem_layout_error_warning.R b/tests/testthat/test-set_sem_layout_error_warning.R new file mode 100644 index 0000000..696b102 --- /dev/null +++ b/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") + })