standardize() fails in some cases

R/standardize.models.R

@@ -92,7 +92,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)"),
     ...
   )
 }
@@ -104,10 +104,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 = '.")
@@ -272,10 +272,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)
     })
   }
 
@@ -373,7 +373,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,
@@ -399,7 +399,7 @@
   #
   #   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))) {
@@ -410,7 +410,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
@@ -484,7 +484,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 @@
   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", {
@@ -55,7 +64,7 @@
 
 
 # Transformations ---------------------------------------------------------
 test_that("transformations", {
   skip_if_not_installed("effectsize")
   # deal with log / sqrt terms
   expect_message(standardize(lm(mpg ~ sqrt(cyl) + log(hp), mtcars)))
@@ -71,12 +80,14 @@
   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
   )
 
@@ -125,12 +136,14 @@
   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
   )
 })