standardize() fails in some cases

R/standardize.models.R

@@ -84,7 +84,7 @@
     weights = weights,
     verbose = verbose,
     include_response = include_response,
-    update_expr = stats::update(x, data = data_std),
+    update_expr = str2lang("stats::update(x, data = data_std)"),
     ...
   )
 }
@@ -96,10 +96,10 @@
                                 weights = TRUE,
                                 verbose = TRUE,
                                 include_response = TRUE,
                                 update_expr,
                                 ...) {
   m_info <- .get_model_info(x, ...)
   data <- insight::get_data(x, source = "mf", verbose = FALSE)
 
   if (isTRUE(attr(data, "is_subset"))) {
     insight::format_error("Cannot standardize a model fit with a 'subset = '.")
@@ -264,10 +264,10 @@
   on.exit(.update_failed())
 
   if (isTRUE(verbose)) {
-    model_std <- eval(substitute(update_expr))
+    model_std <- eval(update_expr)
   } else {
     utils::capture.output({
-      model_std <- eval(substitute(update_expr))
+      model_std <- eval(update_expr)
     })
   }
 
@@ -365,7 +365,7 @@
 
 
   if (!is.null(covs)) {
     covs <- mapply(.rescale_fixed_values, covs, names(covs),
       SIMPLIFY = FALSE,
       MoreArgs = list(
         y_data = y_data, m_data = m_data,
@@ -389,9 +389,9 @@
   #                                      y_data = y_data, m_data = m_data,
   #                                      y_data_std = y_data_std, m_data_std = m_data_std)
   #
   #   control.value <- temp_vals[1]
   #   treat.value <- temp_vals[2]
   #   if (verbose) insight::format_alert("control and treatment values have been rescaled to their standardized scales.")
   # }
 
   if (verbose && !all(c(control.value, treat.value) %in% c(0, 1))) {
@@ -402,7 +402,7 @@
   }
 
 
   text <- utils::capture.output({
     model_std <- stats::update(x,
       model.y = y_std, model.m = m_std,
       # control.value = control.value, treat.value = treat.value
@@ -447,7 +447,7 @@
 # Find log-terms inside model formula, and return "clean" term names
 .log_terms <- function(model, data) {
   x <- insight::find_terms(model, flatten = TRUE)
   # log_pattern <- "^log\\((.*)\\)"
   log_pattern <- "(log\\(log|log|log1|log10|log1p|log2)\\(([^,\\+)]*).*"
   out <- insight::trim_ws(gsub(log_pattern, "\\2", grep(log_pattern, x, value = TRUE)))
   intersect(colnames(data), out)
@@ -476,7 +476,7 @@
 
   # check if model has a response variable that should not be standardized.
   info$is_linear &&
     !info$family == "inverse.gaussian" &&
     !info$is_survival &&
     !info$is_censored
 

tests/testthat/test-standardize_models.R

@@ -6,7 +6,16 @@ test_that("standardize.lm", {
   m0 <- lm(Sepal.Length ~ Species * Petal.Width, data = iris_z)
   m1 <- lm(Sepal.Length ~ Species * Petal.Width, data = iris2)
   model <- standardize(m1)
-  expect_identical(coef(m0), coef(model))
+  expect_equal(coef(m0), coef(model), tolerance = 1e-5)
+})
+
+test_that("standardize.lm, edge case (intercept only)", {
+  iris2 <- na.omit(iris)
+  iris_z <- standardize(iris2)
+  m0 <- lm(Sepal.Length ~ 1, data = iris_z)
+  m1 <- lm(Sepal.Length ~ 1, data = iris2)
+  model <- standardize(m1)
+  expect_equal(coef(m0), coef(model), tolerance = 1e-5)
 })
 
 test_that("standardize, mlm", {
@@ -48,12 +57,14 @@ test_that("transformations", {
   expect_equal(
     effectsize::standardize_parameters(fit_exp, method = "refit")[2, 2],
     unname(coef(fit_scale1)[2]),
+    tolerance = 1e-4
     ignore_attr = TRUE
   )
 
   expect_equal(
     effectsize::standardize_parameters(fit_exp, method = "basic")[2, 2],
     unname(coef(fit_scale2)[2]),
+    tolerance = 1e-4
     ignore_attr = TRUE
   )
 
@@ -103,12 +114,14 @@ test_that("weights", {
   expect_equal(
     stdREFIT[[2]],
     effectsize::standardize_parameters(m, method = "posthoc")[[2]],
+    tolerance = 1e-4
     ignore_attr = TRUE
   )
 
   expect_equal(
     stdREFIT[[2]],
     effectsize::standardize_parameters(m, method = "basic")[[2]],
+    tolerance = 1e-4
     ignore_attr = TRUE
   )
 })