From aafd8e9bf668ead5b25996f9187b13806f63dbae Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 1 Jul 2023 19:52:30 +0200 Subject: [PATCH 1/5] `standardize()` fails in some cases Fixes #441 --- R/standardize.models.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/standardize.models.R b/R/standardize.models.R index 8d20766e7..d1a84801b 100644 --- a/R/standardize.models.R +++ b/R/standardize.models.R @@ -84,7 +84,7 @@ standardize.default <- function(x, 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)"), ... ) } @@ -264,10 +264,10 @@ standardize.default <- function(x, 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) }) } From 903051439e552416fff9faaab9ecbe11b14d914d Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 1 Jul 2023 20:03:14 +0200 Subject: [PATCH 2/5] get data from environment --- R/standardize.models.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/standardize.models.R b/R/standardize.models.R index d1a84801b..b97dc96cf 100644 --- a/R/standardize.models.R +++ b/R/standardize.models.R @@ -99,7 +99,7 @@ standardize.default <- function(x, update_expr, ...) { m_info <- .get_model_info(x, ...) - data <- insight::get_data(x, source = "mf", verbose = FALSE) + data <- insight::get_data(x, source = "environment", verbose = FALSE) if (isTRUE(attr(data, "is_subset"))) { insight::format_error("Cannot standardize a model fit with a 'subset = '.") From 898b229312c9d0664b7f8111f7eb065e31e72472 Mon Sep 17 00:00:00 2001 From: Daniel Date: Sat, 1 Jul 2023 20:06:46 +0200 Subject: [PATCH 3/5] desc --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 6a0264ee0..3c71a6343 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: datawizard Title: Easy Data Wrangling and Statistical Transformations -Version: 0.8.0.4 +Version: 0.8.0.5 Authors@R: c( person("Indrajeet", "Patil", , "patilindrajeet.science@gmail.com", role = "aut", comment = c(ORCID = "0000-0003-1995-6531", Twitter = "@patilindrajeets")), From a8fa07db0d69e61c9bf36faf419b82c58d13b169 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 12 Sep 2023 22:18:45 +0200 Subject: [PATCH 4/5] still fetch data from model frame first --- R/standardize.models.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/standardize.models.R b/R/standardize.models.R index b97dc96cf..d1a84801b 100644 --- a/R/standardize.models.R +++ b/R/standardize.models.R @@ -99,7 +99,7 @@ standardize.default <- function(x, update_expr, ...) { m_info <- .get_model_info(x, ...) - data <- insight::get_data(x, source = "environment", verbose = FALSE) + 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 = '.") From 43cff24e1fe5d96ade683d584f48dc755f3be0c7 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 12 Sep 2023 22:23:10 +0200 Subject: [PATCH 5/5] test --- tests/testthat/test-standardize_models.R | 56 ++++++++++++++++++------ 1 file changed, 42 insertions(+), 14 deletions(-) diff --git a/tests/testthat/test-standardize_models.R b/tests/testthat/test-standardize_models.R index 4e1706ce5..dcaa832d5 100644 --- a/tests/testthat/test-standardize_models.R +++ b/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", { @@ -47,12 +56,14 @@ test_that("transformations", { fit_scale2 <- lm(scale(mpg) ~ scale(exp(hp_100)), mt) expect_equal( effectsize::standardize_parameters(fit_exp, method = "refit")[2, 2], - unname(coef(fit_scale1)[2]) + unname(coef(fit_scale1)[2]), + tolerance = 1e-4 ) expect_equal( effectsize::standardize_parameters(fit_exp, method = "basic")[2, 2], - unname(coef(fit_scale2)[2]) + unname(coef(fit_scale2)[2]), + tolerance = 1e-4 ) skip_if_not_installed("insight", minimum_version = "0.10.0") @@ -64,7 +75,9 @@ test_that("transformations", { m <- lm(log(sum + 1) ~ as.numeric(time) * group, data = d) - expect_message(out <- standardize(m)) + expect_message({ + out <- standardize(m) + }) expect_identical(coef(m), c( `(Intercept)` = -0.4575, `as.numeric(time)` = 0.5492, group = 0.3379, `as.numeric(time):group` = 0.15779 @@ -98,12 +111,14 @@ test_that("weights", { stdREFIT <- effectsize::standardize_parameters(m, method = "refit") expect_equal( stdREFIT[[2]], - effectsize::standardize_parameters(m, method = "posthoc")[[2]] + effectsize::standardize_parameters(m, method = "posthoc")[[2]], + tolerance = 1e-4 ) expect_equal( stdREFIT[[2]], - effectsize::standardize_parameters(m, method = "basic")[[2]] + effectsize::standardize_parameters(m, method = "basic")[[2]], + tolerance = 1e-4 ) }) @@ -230,7 +245,9 @@ test_that("standardize mediation", { ) out1 <- summary(standardize(med1)) - expect_message(out2 <- summary(standardize(med2))) + expect_message({ + out2 <- summary(standardize(med2)) + }) expect_identical(unlist(out1[c("d0", "d1", "z0", "z1", "n0", "n1", "tau.coef")]), unlist(out2[c("d0", "d1", "z0", "z1", "n0", "n1", "tau.coef")]), tolerance = 0.1 @@ -266,13 +283,19 @@ test_that("offsets", { m <- lm(mpg ~ hp + offset(wt), data = mtcars) - expect_warning(mz1 <- standardize(m)) - expect_warning(mz2 <- standardize(m, two_sd = TRUE)) + expect_warning({ + mz1 <- standardize(m) + }) + expect_warning({ + mz2 <- standardize(m, two_sd = TRUE) + }) expect_identical(c(1, 2) * coef(mz1), coef(mz2)) m <- glm(cyl ~ hp + offset(wt), family = poisson(), data = mtcars) - expect_warning(mz <- standardize(m), regexp = NA) + expect_warning({ + mz <- standardize(m) + }, regexp = NA) par1 <- parameters::model_parameters(mz) par2 <- effectsize::standardize_parameters(m, method = "basic") @@ -288,10 +311,15 @@ test_that("brms", { skip_if_not_installed("brms") invisible( - capture.output(mod <- brms::brm(mpg ~ hp, - data = mtcars, - refresh = 0, chains = 1, silent = 2 - )) + capture.output( + { + mod <- brms::brm( + mpg ~ hp, + data = mtcars, + refresh = 0, chains = 1, silent = 2 + ) + } + ) ) expect_warning(