refactor prepare_graph.lavaan to remove function calls from arguments…

…, add tests. closes #93

DESCRIPTION

@@ -36,7 +36,7 @@ Imports:
     lavaan,
     blavaan,
     MplusAutomation,
-    igraph,
+    igraph (>= 2.0.0),
     psych,
     methods,
     gtable,
@@ -47,7 +47,7 @@ Imports:
     car,
     future.apply,
     progressr,
-    nonnest2 (>= 0.5.6),
+    nonnest2 (>= 0.5.6)
 Suggests: 
     testthat,
     knitr,
@@ -64,7 +64,8 @@ Suggests:
     yaml,
     formatR,
     dagitty,
-    mice
+    mice,
+    ggraph
 VignetteBuilder: 
     knitr
 Encoding: UTF-8

NAMESPACE

@@ -688,6 +688,7 @@ importFrom(ggplot2,theme_bw)
 importFrom(ggplot2,unit)
 importFrom(graphics,plot)
 importFrom(igraph,graph.data.frame)
+importFrom(igraph,graph_from_data_frame)
 importFrom(igraph,layout_as_star)
 importFrom(igraph,layout_as_tree)
 importFrom(igraph,layout_in_circle)

R/mixture-pseudo_class.R

@@ -331,35 +331,35 @@ append_class_draws <- function(x, data = NULL, m = 20) {
 #'
 #' pct_mx <- pseudo_class(x = fit,
 #'                        model = "SL ~ class",
-#'                        data = dat)
+#'                        data = dat,
+#'                        m = 2)
 #'
 #' pct_lm <- pseudo_class(x = fit,
 #'              model = lm( SL ~ class, data = data),
-#'              data = dat)
+#'              data = dat,
+#'              m = 2)
 #'
 #'
 #' pcte <- pseudo_class(x = fit,
 #'                      model = lm(SL ~ class, data = data),
 #'                      data = dat,
-#'                      m = 10)
+#'                      m = 2)
 #'
 #' pct_func <- pseudo_class(x = fit,
 #'                          model = function(data){lm(SL ~ class, data = data)},
 #'                          data = dat,
-#'                          m = 10)
+#'                          m = 2)
 #'
 #'
 # pseudo_class(x = fit,
 #              model = nnet::multinom( class ~ SL + SW + PL ) ) -> membership_prediction
 #'
-#'
-#'
 #' @references
 #' Pseudo-class technique:
-#'   Wang C-P, Brown CH, Bandeen-Roche K (2005). Residual Diagnostics for Growth
-#'   Mixture Models: Examining the Impact of a Preventive Intervention on
-#'   Multiple Trajectories of Aggressive Behavior. Journal of the American
-#'   Statistical Association 100(3):1054-1076. \doi{10.1198/016214505000000501}
+#' Wang C-P, Brown CH, Bandeen-Roche K (2005). Residual Diagnostics for Growth
+#' Mixture Models: Examining the Impact of a Preventive Intervention on
+#' Multiple Trajectories of Aggressive Behavior. Journal of the American
+#' Statistical Association 100(3):1054-1076. \doi{10.1198/016214505000000501}
 #'
 #' Pooling results across samples:
 #' Van Buuren, S. 2018. Flexible Imputation of Missing Data. Second Edition.

R/plot-generate_layout.R

@@ -136,12 +136,12 @@ get_layout.tidy_results <- function(x, ..., layout_algorithm = "layout_as_tree")
 
 #' @method get_layout tidy_edges
 #' @export
-#' @importFrom igraph graph.data.frame vertex.attributes
+#' @importFrom igraph graph_from_data_frame vertex.attributes
 #' layout_as_star layout_as_tree layout_in_circle layout_nicely
 #' layout_on_grid layout_randomly layout_with_dh layout_with_fr layout_with_gem
 #' layout_with_graphopt layout_with_kk layout_with_lgl layout_with_mds
 get_layout.tidy_edges <- function(x, ..., layout_algorithm = "layout_as_tree"){
-  g <- graph.data.frame(x, directed = TRUE)
+  g <- igraph::graph_from_data_frame(x, directed = TRUE)
   lo <- do.call(layout_algorithm, list(g))
   lo <- round(lo)
   if(any(duplicated(lo))){

R/plot-plot_sem.R

@@ -538,23 +538,42 @@ prepare_graph.lavaan <- function(model,
                                  nodes = NULL,
                                  ...){
   #browser()
-  if(is.null(edges)) edges <- quote(get_edges(model))
-  if(is.null(layout)) layout <- quote(get_layout(model))
-  if(is.null(nodes)) nodes <- quote(get_nodes(model))
+
   dots <- match.call(expand.dots = FALSE)[["..."]]
+
   pass_args <- c("label", "digits", "columns")
-  edges <- substitute(edges)
-  layout <- substitute(layout)
-  nodes <- substitute(nodes)
-  if(any(pass_args %in% names(dots))){
-    for(this_arg in pass_args[pass_args %in% names(dots)]){
-      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
-      }
-    }
+
+  if(is.null(edges)){
+    edges <- do.call(call, args = c(list(
+      name = "get_edges",
+      x = model
+    ), dots[names(dots) %in% pass_args]), quote = TRUE)
   }
+  if(is.null(nodes)){
+    nodes <- do.call(call, args = c(list(
+      name = "get_nodes",
+      x = model
+    ), dots[names(dots) %in% pass_args]), quote = TRUE)
+  }
+  if(is.null(layout)){
+    layout <- do.call(call, args = c(list(
+      name = "get_layout",
+      x = model
+    ), dots[names(dots) %in% pass_args]), quote = TRUE)
+  }
+
+  # if(any(pass_args %in% names(dots))){
+  #   for(this_arg in pass_args[pass_args %in% names(dots)]){
+  #     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
+  #     }
+  #   }
+  # }
+  # if(is.null(layout)) layout <- quote(get_layout(model))
+  # if(is.null(nodes)) nodes <- quote(get_nodes(model))
+
   Args <- as.list(match.call(expand.dots = FALSE)[-1])
   model <- model
   Args[["..."]] <- NULL
@@ -564,8 +583,8 @@ prepare_graph.lavaan <- function(model,
   # They are available in the parent environment, but `model` is not.
   # Maybe make new environment and add model to it?
   # It's a hack, but seems to pass all tests.
-  use_env <- parent.frame()
-  assign("model", model, envir = use_env)
+  # use_env <- parent.frame()
+  # assign("model", model, envir = use_env)
   Args[["edges"]] <-  eval(edges)#, envir = use_env)
   Args[["nodes"]] <-  eval(nodes)#, envir = use_env)
   Args[["layout"]] <- eval(layout)#, envir = use_env)

news.md

@@ -1,5 +1,7 @@
 # tidySEM 0.2.7
 
+* Stop calling tidySEM functions as default arguments of prepare_graph.lavaan().
+  This ensures that tidySEM works when its namespace is not attached.
 * Frank Gootjes contributed pseudo class functionality, new functions are
   append_class_draws() and pseudo_class()
 

tests/testthat/test-namespace_checks_dominique.R

@@ -0,0 +1,16 @@
+detach("package:tidySEM", unload = TRUE)
+m <- lavaan::sem('
+     ind60 =~ x1 + x2 + x3
+     dem60 =~ y1 + a*y2 + b*y3
+', data = lavaan::PoliticalDemocracy)
+
+test_that("graph_sem works when tidySEM is not attached", {
+  expect_error({tidySEM::graph_sem(m, edges = tidySEM::get_edges(m))}, NA)
+})
+
+library(tidySEM)
+library(ggraph)
+test_that("graph_sem works when ggraph masks get_edges etc", {
+  expect_error({tidySEM::graph_sem(m)}, NA)
+})
+detach("package:ggraph", unload = TRUE)