From 06b8ed09fe86fe8b3c29795d2d03f0d338495cc5 Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 16 Mar 2023 15:06:12 +0100 Subject: [PATCH 1/5] add support for `fixest_multi` --- DESCRIPTION | 2 +- NAMESPACE | 4 ++++ NEWS.md | 5 +++++ R/check_outliers.R | 11 +++++++++++ R/check_overdispersion.R | 5 +++++ R/model_performance.lm.R | 5 +++++ R/r2.R | 5 +++++ 7 files changed, 36 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index e94a60345..f9ddfc0d5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Type: Package Package: performance Title: Assessment of Regression Models Performance -Version: 0.10.2.5 +Version: 0.10.2.6 Authors@R: c(person(given = "Daniel", family = "Lüdecke", diff --git a/NAMESPACE b/NAMESPACE index 4a01325fb..db8676313 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -73,6 +73,7 @@ S3method(check_outliers,character) S3method(check_outliers,data.frame) S3method(check_outliers,default) S3method(check_outliers,fixest) +S3method(check_outliers,fixest_multi) S3method(check_outliers,geeglm) S3method(check_outliers,glmmTMB) S3method(check_outliers,glmrob) @@ -83,6 +84,7 @@ S3method(check_outliers,lmrob) S3method(check_outliers,numeric) S3method(check_overdispersion,default) S3method(check_overdispersion,fixest) +S3method(check_overdispersion,fixest_multi) S3method(check_overdispersion,glm) S3method(check_overdispersion,glmmTMB) S3method(check_overdispersion,glmx) @@ -145,6 +147,7 @@ S3method(model_performance,coxph) S3method(model_performance,default) S3method(model_performance,felm) S3method(model_performance,fixest) +S3method(model_performance,fixest_multi) S3method(model_performance,flexsurvreg) S3method(model_performance,glm) S3method(model_performance,glmmTMB) @@ -331,6 +334,7 @@ S3method(r2,default) S3method(r2,feis) S3method(r2,felm) S3method(r2,fixest) +S3method(r2,fixest_multi) S3method(r2,gam) S3method(r2,glm) S3method(r2,glmmTMB) diff --git a/NEWS.md b/NEWS.md index b3fbaa688..ffc92ec17 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,11 @@ * `item_discrimination()`, to calculate the discrimination of a scale's items. +## Support for new models + +* `model_performance()`, `check_overdispersion()`, `check_outliers()` and `r2()` + now work with objects of class `fixest_multi` (@etiennebacher). + ## Changes to functions * Warnings in `model_performance()` for unsupported objects of class diff --git a/R/check_outliers.R b/R/check_outliers.R index cc8b7b10f..b984b2a3c 100644 --- a/R/check_outliers.R +++ b/R/check_outliers.R @@ -1220,6 +1220,15 @@ check_outliers.lme <- check_outliers.gls #' @export check_outliers.fixest <- check_outliers.gls +#' @export +check_outliers.fixest_multi <- function(x, + method = "pareto", + threshold = NULL, + ID = NULL, + ...) { + lapply(model, check_outliers.fixest) +} + #' @export check_outliers.geeglm <- check_outliers.gls @@ -1488,6 +1497,8 @@ check_outliers.geeglm <- check_outliers.gls } # Compute + print(x) + print(cov(x)) out$Distance_Mahalanobis <- stats::mahalanobis(x, center = colMeans(x), cov = stats::cov(x), ...) # Filter diff --git a/R/check_overdispersion.R b/R/check_overdispersion.R index 8748c77ff..29606b0d7 100644 --- a/R/check_overdispersion.R +++ b/R/check_overdispersion.R @@ -190,6 +190,11 @@ check_overdispersion.glm <- function(x, verbose = TRUE, ...) { #' @export check_overdispersion.fixest <- check_overdispersion.glm +#' @export +check_overdispersion.fixest_multi <- function(x, verbose = TRUE, ...) { + lapply(x, check_overdispersion.fixest) +} + #' @export check_overdispersion.glmx <- check_overdispersion.glm diff --git a/R/model_performance.lm.R b/R/model_performance.lm.R index 32566f484..cdb5829b2 100644 --- a/R/model_performance.lm.R +++ b/R/model_performance.lm.R @@ -235,6 +235,11 @@ model_performance.vglm <- model_performance.lm #' @export model_performance.fixest <- model_performance.lm +#' @export +model_performance.fixest_multi <- function(model, metrics = "all", verbose = TRUE, ...) { + lapply(model, model_performance.fixest) +} + #' @export model_performance.DirichletRegModel <- model_performance.lm diff --git a/R/r2.R b/R/r2.R index 359651de0..9c52a19f7 100644 --- a/R/r2.R +++ b/R/r2.R @@ -638,6 +638,11 @@ r2.fixest <- function(model, ...) { structure(class = "r2_generic", out) } +#' @export +r2.fixest_multi <- function(model, ...) { + lapply(model, r2.fixest) +} + #' @export From 606dd2b640249c9ee2ced46a78ec139a4ba5a579 Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 16 Mar 2023 15:45:40 +0100 Subject: [PATCH 2/5] add tests --- R/check_outliers.R | 2 +- .../testthat/test-model_performance.fixest.R | 18 ----- tests/testthat/test-pkg-fixest.R | 79 +++++++++++++++++++ 3 files changed, 80 insertions(+), 19 deletions(-) delete mode 100644 tests/testthat/test-model_performance.fixest.R create mode 100644 tests/testthat/test-pkg-fixest.R diff --git a/R/check_outliers.R b/R/check_outliers.R index b984b2a3c..226c8e605 100644 --- a/R/check_outliers.R +++ b/R/check_outliers.R @@ -1226,7 +1226,7 @@ check_outliers.fixest_multi <- function(x, threshold = NULL, ID = NULL, ...) { - lapply(model, check_outliers.fixest) + lapply(x, check_outliers.fixest) } #' @export diff --git a/tests/testthat/test-model_performance.fixest.R b/tests/testthat/test-model_performance.fixest.R deleted file mode 100644 index 8ada01439..000000000 --- a/tests/testthat/test-model_performance.fixest.R +++ /dev/null @@ -1,18 +0,0 @@ -.runThisTest <- Sys.getenv("RunAllperformanceTests") == "yes" - -if (.runThisTest && requiet("parameters") && requiet("fixest") && getRversion() >= "3.6.0") { - data("qol_cancer", package = "parameters") - qol_cancer <- cbind( - qol_cancer, - datawizard::demean(qol_cancer, select = c("phq4", "QoL"), group = "ID") - ) - - m <- feols( - QoL ~ time + phq4 | ID, - data = qol_cancer - ) - mp <- model_performance(m) - - test_that("model_performance.fixest", { - }) -} diff --git a/tests/testthat/test-pkg-fixest.R b/tests/testthat/test-pkg-fixest.R new file mode 100644 index 000000000..5888b9d07 --- /dev/null +++ b/tests/testthat/test-pkg-fixest.R @@ -0,0 +1,79 @@ +base <- iris +names(base) <- c("y1", "y2", "x1", "x2", "species") + +test_that("fixest: r2", { + skip_if_not_installed("fixest") + res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) + r2_res <- r2(res) + + expect_equal(r2_res$R2, fitstat(res, "r2")[[1]]) + expect_equal(r2_res$R2_adjusted, fitstat(res, "ar2")[[1]]) + expect_equal(r2_res$R2_within, fitstat(res, "wr2")[[1]]) + expect_equal(r2_res$R2_within_adjusted, fitstat(res, "war2")[[1]]) +}) + + +test_that("fixest: overdispersion", { + skip_if_not_installed("fixest") + res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) + expect_error( + check_overdispersion(res), + "can only be used for models from Poisson" + ) +}) + +test_that("fixest: outliers", { + skip_if_not_installed("fixest") + res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) + outliers_list <- suppressMessages(check_outliers(res)) + expect_identical(attr(outliers_list, "outlier_count"), list()) +}) + +test_that("fixest: model_performance", { + skip_if_not_installed("fixest") + res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) + perf <- model_performance(res) + expect_equal(perf$AIC, 107.743, tolerance = 1e-3) + expect_equal(perf$BIC, 125.807, tolerance = 1e-3) + expect_equal(perf$R2, 0.837, tolerance = 1e-3) + expect_equal(perf$R2_adjusted, 0.832, tolerance = 1e-3) + expect_equal(perf$R2_within, 0.573, tolerance = 1e-3) + expect_equal(perf$R2_within_adjusted, 0.564, tolerance = 1e-3) + expect_equal(perf$RMSE, 0.333, tolerance = 1e-3) + expect_equal(perf$Sigma, 0.340, tolerance = 1e-3) +}) + + + +test_that("fixest_multi: r2", { + skip_if_not_installed("fixest") + res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) + r2_res <- r2(res) + + expect_equal(r2_res[[1]]$R2, 0.837, tolerance = 1e-3) +}) + +test_that("fixest_multi: overdispersion", { + skip_if_not_installed("fixest") + res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) + expect_error( + check_overdispersion(res), + "can only be used for models from Poisson" + ) +}) + +test_that("fixest_multi: outliers", { + skip_if_not_installed("fixest") + res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) + outliers_list <- suppressMessages(check_outliers(res)[[1]]) + expect_identical(attr(outliers_list, "outlier_count"), list()) +}) + +test_that("fixest_multi: model_performance", { + skip_if_not_installed("fixest") + res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) + res2 <- feols(y1 ~ x1 + x2 + x2^2 | species, base) + perf <- model_performance(res) + perf2 <- model_performance(res2) + expect_identical(perf[[2]], perf2) +}) From 741926bd27b8fd3880fb0b5c2a1005f68ff0bc53 Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 16 Mar 2023 20:52:50 +0100 Subject: [PATCH 3/5] PR number in news --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ffc92ec17..63ad27107 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,7 +7,7 @@ ## Support for new models * `model_performance()`, `check_overdispersion()`, `check_outliers()` and `r2()` - now work with objects of class `fixest_multi` (@etiennebacher). + now work with objects of class `fixest_multi` (@etiennebacher, #554). ## Changes to functions From f3cb270aa6805cd30a0361356b8d099c7046f3af Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 16 Mar 2023 20:53:50 +0100 Subject: [PATCH 4/5] typos --- R/check_outliers.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/check_outliers.R b/R/check_outliers.R index 226c8e605..ea9c6625d 100644 --- a/R/check_outliers.R +++ b/R/check_outliers.R @@ -1497,8 +1497,6 @@ check_outliers.geeglm <- check_outliers.gls } # Compute - print(x) - print(cov(x)) out$Distance_Mahalanobis <- stats::mahalanobis(x, center = colMeans(x), cov = stats::cov(x), ...) # Filter From 5d2d18021226a1391a8a00603e5e9fc000e01411 Mon Sep 17 00:00:00 2001 From: etiennebacher Date: Thu, 16 Mar 2023 21:10:11 +0100 Subject: [PATCH 5/5] fix tests --- tests/testthat/test-pkg-fixest.R | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-pkg-fixest.R b/tests/testthat/test-pkg-fixest.R index 5888b9d07..1b0e01849 100644 --- a/tests/testthat/test-pkg-fixest.R +++ b/tests/testthat/test-pkg-fixest.R @@ -1,10 +1,11 @@ base <- iris -names(base) <- c("y1", "y2", "x1", "x2", "species") +names(base) <- c("y1", "y2", "x1", "x2", "species") test_that("fixest: r2", { skip_if_not_installed("fixest") + library(fixest) res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) - r2_res <- r2(res) + r2_res <- performance::r2(res) expect_equal(r2_res$R2, fitstat(res, "r2")[[1]]) expect_equal(r2_res$R2_adjusted, fitstat(res, "ar2")[[1]]) @@ -15,6 +16,7 @@ test_that("fixest: r2", { test_that("fixest: overdispersion", { skip_if_not_installed("fixest") + library(fixest) res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) expect_error( check_overdispersion(res), @@ -24,6 +26,7 @@ test_that("fixest: overdispersion", { test_that("fixest: outliers", { skip_if_not_installed("fixest") + library(fixest) res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) outliers_list <- suppressMessages(check_outliers(res)) expect_identical(attr(outliers_list, "outlier_count"), list()) @@ -31,6 +34,7 @@ test_that("fixest: outliers", { test_that("fixest: model_performance", { skip_if_not_installed("fixest") + library(fixest) res <- feols(y1 ~ x1 + x2 + x2^2 | species, base) perf <- model_performance(res) expect_equal(perf$AIC, 107.743, tolerance = 1e-3) @@ -47,14 +51,16 @@ test_that("fixest: model_performance", { test_that("fixest_multi: r2", { skip_if_not_installed("fixest") + library(fixest) res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) - r2_res <- r2(res) + r2_res <- performance::r2(res) - expect_equal(r2_res[[1]]$R2, 0.837, tolerance = 1e-3) + expect_equal(unname(r2_res[[1]]$R2), 0.837, tolerance = 1e-3) }) test_that("fixest_multi: overdispersion", { skip_if_not_installed("fixest") + library(fixest) res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) expect_error( check_overdispersion(res), @@ -64,6 +70,7 @@ test_that("fixest_multi: overdispersion", { test_that("fixest_multi: outliers", { skip_if_not_installed("fixest") + library(fixest) res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) outliers_list <- suppressMessages(check_outliers(res)[[1]]) expect_identical(attr(outliers_list, "outlier_count"), list()) @@ -71,6 +78,7 @@ test_that("fixest_multi: outliers", { test_that("fixest_multi: model_performance", { skip_if_not_installed("fixest") + library(fixest) res <- feols(c(y1, y2) ~ x1 + csw(x2, x2^2) | species, base) res2 <- feols(y1 ~ x1 + x2 + x2^2 | species, base) perf <- model_performance(res)