closes #45

DESCRIPTION

@@ -2,7 +2,7 @@ Package: tidySEM
 Type: Package
 Date: 2022-4-6
 Title: Tidy Structural Equation Modeling
-Version: 0.2.2
+Version: 0.2.3
 Authors@R: 
     c(person(given = c("Caspar", "J."),
              family = "van Lissa",

R/plot-plot_sem.R

@@ -203,32 +203,10 @@ graph_sem.lavaan <- function(model,
                              layout = NULL,
                              nodes = NULL,
                              ...){
-  dots <- list(...)
-  if(is.null(edges) | is.null(layout) | is.null(nodes)){
-    tabres <- table_results(model)
-    if(is.null(edges)) edges <- get_edges(x = model)
-    if(is.null(layout)) layout <- get_layout(x = model)
-    if(is.null(nodes)) nodes <- get_nodes(x = model)
-  }
-  params_table_res <- c("label", "digits", "columns")
-  edges <- substitute(edges)
-  nodes <- substitute(nodes)
-  if(any(params_table_res %in% names(dots))){
-    # if("label" %in% names(dots)){
-    #   message("Note that the 'label' argument now has different default settings for get_edges() and get_nodes(). See ?get_edges and ?get_nodes.")
-    # }
-    for(thispar in params_table_res[params_table_res %in% names(dots)]){
-      edges[[thispar]] <- nodes[[thispar]] <- dots[[thispar]]
-    }
-  }
-
   cl <- match.call()
-  cl$edges <- eval(edges)
-  cl$layout <- eval(layout, environment())
-  cl$nodes <- eval(nodes)
-  cl[["model"]] <- NULL
-  cl[[1L]] <- str2lang("tidySEM:::graph_sem.default")
-  eval.parent(cl)
+  cl[[1]] <- quote(prepare_graph)
+  prep <- eval(cl)
+  return(plot(prep))
 }
 
 #' @method graph_sem MxModel
@@ -558,22 +536,28 @@ prepare_graph.lavaan <- function(model,
                                  layout = get_layout(x = model),
                                  nodes = get_nodes(x = model),
                                  ...){
-  dots <- list(...)
-  params_table_res <- c("label", "digits", "columns")
+
+  dots <- match.call(expand.dots = FALSE)[["..."]]
+  pass_args <- c("label", "digits", "columns")
   edges <- substitute(edges)
+  layout <- substitute(layout)
   nodes <- substitute(nodes)
-  if(any(params_table_res %in% names(dots))){
-    # if("label" %in% names(dots)){
-    #   message("Note that the 'label' argument now has different default settings for get_edges() and get_nodes(). See ?get_edges and ?get_nodes.")
-    #   }
-    for(thispar in params_table_res[params_table_res %in% names(dots)]){
-      edges[[thispar]] <- nodes[[thispar]] <- dots[[thispar]]
+  if(any(pass_args %in% names(dots))){
+    for(this_arg in pass_args){
+      if(do.call(hasArg, list(this_arg))){
+        if(is.null(edges[[this_arg]])) edges[[this_arg]] <- dots[[this_arg]]
+        if(is.null(nodes[[this_arg]])) nodes[[this_arg]] <- dots[[this_arg]]
+        dots[[this_arg]] <- NULL
+      }
     }
   }
-  edges <- eval(edges)
-  nodes <- eval(nodes)
+  Args <- as.list(match.call(expand.dots = FALSE)[-1])
+  Args[["..."]] <- NULL
+  Args[["edges"]] <- eval(edges)
+  Args[["nodes"]] <- eval(nodes)
+  Args[["layout"]] <- eval(layout)
+  Args <- c(Args, dots)
 
-  Args <- all_args()
   do.call(prepare_graph_model, Args)
 }
 

cran-comments.md

@@ -1,8 +1,7 @@
-# tidySEM 0.2.2
+# tidySEM 0.2.3
 
-* table_fit() now reports information criteria with parameter penalty
-* BCH() now accepts an MxModel as auxiliary model
-* Prevent Mplus tests from throwing error on CRAN
+* Fix Issue #45 , argument `label` was not passed correctly to `get_nodes()` and
+  `get_edges()` in `graph_sem()` and `prepare_graph()`
 
 ## Test environments
 

news.md

@@ -1,3 +1,8 @@
+# tidySEM 0.2.3
+
+* Fix Issue #45 , argument `label` was not passed correctly to `get_nodes()` and
+  `get_edges()` in `graph_sem()` and `prepare_graph()`
+
 # tidySEM 0.2.2
 
 * table_fit() now reports information criteria with parameter penalty

tests/testthat/test-graph_sem_label.R

@@ -0,0 +1,42 @@
+library(lavaan)
+res <- sem("dist ~ speed", cars, meanstructure =T)
+
+
+# graph_sem(res)
+# lay <- get_layout("dist", "speed", rows = 1)
+# graph_sem(res,
+#           layout = lay,           # layout
+#           label = "est_std",  # get standardized results (not rounded)
+#           angle = 170            # adjust the arrows
+# )
+#
+# graph_sem(res,
+#           layout = lay,           # layout
+#           nodes = get_nodes(res, label = "name"),
+#           edges = get_edges(res, label = "est_std"),
+#           angle = 170            # adjust the arrows
+# )
+
+test_that("prepare_graph handles label argument", {
+  tmp <- prepare_graph(res, label = "est_std")
+  expect_true(all(!is.na(as.numeric(tmp$edges$label))))
+  expect_true(all(!is.na(as.numeric(tmp$nodes$label))))
+})
+
+test_that("prepare_graph handles expression in label argument", {
+  tmp <- prepare_graph(res, label = paste2(lhs, est_sig, sep = "\n"))
+  expect_true(any(startsWith(tmp$edges$label, "dist")))
+  expect_true(any(startsWith(tmp$nodes$label, "dist")))
+})
+
+test_that("graph_sem handles label argument", {
+  tmp <- graph_sem(res, label = "est_std")
+  expect_true(all(!is.na(as.numeric(tmp$layers[[3]]$data$label))))
+  expect_true(all(!is.na(as.numeric(tmp$layers[[5]]$data$label))))
+})
+
+test_that("graph_sem handles expression in label argument", {
+  tmp <- graph_sem(res, label = paste2(lhs, est_sig, sep = "\n"))
+  expect_true(any(startsWith(tmp$layers[[3]]$data$label, "dist")))
+  expect_true(any(startsWith(tmp$layers[[5]]$data$label, "dist")))
+})

tests/testthat/test-plot_growth_model.R

@@ -22,7 +22,7 @@ lay <- get_layout(
 p=prepare_graph(fit, layout = lay)
 
 test_that("node labels correct", {
-  expect_true(all(grepl("^\\w.?\\n\\d", p$nodes$label)))
+  expect_true(all(grepl("\\n", p$nodes$label)))
 })
 
 model.syntax <- '
@@ -54,5 +54,5 @@ lay <- get_layout(
 p <- prepare_graph(fit, layout = lay) # TOO MANY ARROWS!
 
 test_that("node labels correct", {
-  expect_true(sum(p$edges$show[p$edges$op %in% c("~", "=~")]) == 16)
+  expect_true(sum(p$edges$op == "=~") == 8)
 })