Add proper quoting to sim_slopes(), use better update inside sim_slop…

…es()

Closes #71

.gitignore

@@ -43,3 +43,4 @@ doc
 Meta
 
 .DS_Store
+.vscode/launch.json

R/simple_slopes.R

@@ -145,11 +145,11 @@ sim_slopes <- function(model, pred, modx, mod2 = NULL, modx.values = NULL,
   }
 
   # Evaluate the modx, mod2, pred args
-  pred <- quo_name(enexpr(pred))
-  modx <- quo_name(enexpr(modx))
-  if (modx == "NULL") {modx <- NULL}
-  mod2 <- quo_name(enexpr(mod2))
-  if (mod2 == "NULL") {mod2 <- NULL}
+  pred <- as_name(enquo(pred))
+  modx <- enquo(modx)
+  modx <- if (quo_is_null(modx)) {NULL} else {as_name(modx)}
+  mod2 <- enquo(mod2)
+  mod2 <- if (quo_is_null(mod2)) {NULL} else {as_name(mod2)}
 
   # Warn user if interaction term is absent
   if (!check_interactions(as.formula(formula(model)), c(pred, modx, mod2))) {
@@ -433,7 +433,7 @@ sim_slopes <- function(model, pred, modx, mod2 = NULL, modx.values = NULL,
       newmod <- eval(call)
     } else {
       # Creating the model
-      newmod <- update(model, data = dt)
+      newmod <- j_update(model, data = dt)
     }
 
     # Getting SEs, robust or otherwise
@@ -512,7 +512,7 @@ sim_slopes <- function(model, pred, modx, mod2 = NULL, modx.values = NULL,
       call[[1]] <- survey::svyglm
       newmod <- eval(call)
     } else {
-      newmod <- update(model, data = dt)
+      newmod <- j_update(model, data = dt)
     }
 
     # Getting SEs, robust or otherwise

R/utils.R

@@ -236,3 +236,51 @@ generics::tidy
 #'@export
 #'@importFrom generics glance
 generics::glance
+
+### Hadley update #############################################################
+# modified from https://stackoverflow.com/questions/13690184/update-inside-a-function-
+# only-searches-the-global-environment
+#' @importFrom stats update.formula
+
+j_update <- function(mod, formula = NULL, data = NULL, offset = NULL,
+                     weights = NULL, call.env = parent.frame(), ...) {
+  call <- getCall(mod)
+  if (is.null(call)) {
+    stop("Model object does not support updating (no call)", call. = FALSE)
+  }
+  term <- terms(mod)
+  if (is.null(term)) {
+    stop("Model object does not support updating (no terms)", call. = FALSE)
+  }
+
+  if (!is.null(data)) call$data <- data
+  if (!is.null(formula)) call$formula <- update.formula(call$formula, formula)
+  env <- attr(term, ".Environment")
+  # Jacob add
+  # if (!is.null(offset))
+  call$offset <- offset
+  # if (!is.null(weights))
+  call$weights <- weights
+
+
+  extras <- as.list(match.call())[-1]
+  extras <- extras[which(names(extras) %nin% c("mod", "formula", "data",
+                                               "offset", "weights",
+                                               "call.env"))]
+  for (i in seq_along(extras)) {
+    if (is.name(extras[[i]])) {
+      extras[[i]] <- eval(extras[[i]], envir = call.env)
+    }
+  }
+
+  existing <- !is.na(match(names(extras), names(call)))
+  for (a in names(extras)[existing]) call[[a]] <- extras[[a]]
+  if (any(!existing)) {
+    call <- c(as.list(call), extras[!existing])
+    call <- as.call(call)
+  }
+
+  if (is.null(call.env)) {call.env <- parent.frame()}
+
+  eval(call, env, call.env)
+}