tests

Author: vincentarelbundock

R/get_modeldata.R

@@ -49,6 +49,11 @@ get_modeldata <- function(model, additional_variables = FALSE, modeldata = NULL,
         additional_variables <- c(additional_variables, fwts)
     }
 
+    # always need weights in this model class
+    if (any(c("svylm", "svyglm") %in% class(model))) {
+        wts <- TRUE
+    }
+
     # after by
     if (isTRUE(checkmate::check_flag(additional_variables))) {
         out <- hush(insight::get_data(

R/sanitize_variables.R

@@ -31,6 +31,7 @@ sanitize_variables <- function(variables,
       predictors <- list(conditional = predictors)
     } else {
       predictors <- insight::find_variables(model, verbose = FALSE)
+      predictors <- predictors[!names(predictors) %in% "response"]
     }
 
     # unsupported models like pytorch

inst/tinytest/test-elasticity.R

@@ -70,18 +70,22 @@ expect_equivalent(dyex_a, dyex_b)
 
 # Issue #1113: avg_slopes(slope = "eyex") should skip dedup
 requiet("nnet")
-dat <- structure(list(y_region2 = c(1, 1, 1, 2, 2, 2, 2, 2, 1, 2, 2, 
-2, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 1, 2, 1, 2, 2, 3, 3, 3, 3, 
-3, 3, 1, 3, 3, 3, 1, 3, 3, 1, 3, 1, 3, 3, 3, 1, 3, 3), male = c(0, 
-1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0, 
-1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
-1, 0, 0, 1, 0, 0, 1), frenchlanguage = c(1, 1, 1, 1, 1, 1, 1, 
-1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1, 
-1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 
-1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
--50L))
+dat <- structure(list(y_region2 = c(
+  1, 1, 1, 2, 2, 2, 2, 2, 1, 2, 2,
+  2, 1, 2, 2, 2, 2, 2, 2, 1, 2, 2, 2, 1, 2, 1, 2, 2, 3, 3, 3, 3,
+  3, 3, 1, 3, 3, 3, 1, 3, 3, 1, 3, 1, 3, 3, 3, 1, 3, 3), male = c(
+  0,
+  1, 1, 1, 0, 0, 0, 1, 0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 0,
+  1, 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+  1, 0, 0, 1, 0, 0, 1), frenchlanguage = c(
+  1, 1, 1, 1, 1, 1, 1,
+  1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 1,
+  1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+  1)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(
+  NA,
+  -50L))
 dat$male = dat$male + 1e-6
-mod <- multinom(y_region2 ~ male + frenchlanguage, data = dat, trace = FALSE)
+mod <- nnet::multinom(y_region2 ~ male + frenchlanguage, data = dat, Hess = TRUE, trace = FALSE)
 s1 <- avg_slopes(mod, slope = "dydx")
 s2 <- avg_slopes(mod, slope = "dyex")
 s3 <- avg_slopes(mod, slope = "eyex")

inst/tinytest/test-pkg-fixest.R

@@ -25,7 +25,7 @@ mod2 <- suppressMessages(feglm(am ~ mpg | gear, family = binomial(link = "logit"
 mod3 <- suppressMessages(feglm(am ~ mpg + mpg^2 | gear, family = binomial(link = "logit"), data = mtcars, warn = FALSE))
 mod4 <- suppressMessages(feglm(am ~ mpg | gear, family = binomial(link = "logit"), data = mtcars, warn = FALSE))
 
-#skip_if_not_installed("fixest", minimum_version = "0.10.2")
+# skip_if_not_installed("fixest", minimum_version = "0.10.2")
 expect_inherits(insight::get_data(mod1), "data.frame")
 expect_inherits(insight::get_data(mod2), "data.frame")
 expect_inherits(insight::get_data(mod3), "data.frame")
@@ -66,9 +66,10 @@ expect_equivalent(mfx$std.error, mfx$std.errorstata, tolerance = .001)
 
 # fixest::feols: predictions
 data(trade, package = "fixest")
-model <- feols(Euros ~ dist_km | Destination + Origin, data = trade)
+dat <- trade
+model <- feols(Euros ~ dist_km | Destination + Origin, data = dat)
 pred1 <- predictions(model)
-pred2 <- predictions(model, newdata = head(trade))
+pred2 <- predictions(model, newdata = head(dat))
 expect_predictions(pred1)
 expect_predictions(pred2, n_row = 6)
 
@@ -138,8 +139,8 @@ expect_predictions(pred5, se = FALSE)
 
 # bug stay dead: insight::get_data doesn't get all columns
 reg <- feols(
-Sepal.Width ~ Petal.Length | Species | Sepal.Length ~ Petal.Width, 
-data = iris)
+    Sepal.Width ~ Petal.Length | Species | Sepal.Length ~ Petal.Width,
+    data = iris)
 mfx1 <- slopes(reg, newdata = iris)
 mfx2 <- slopes(reg)
 expect_inherits(mfx1, "marginaleffects")
@@ -163,11 +164,11 @@ expect_inherits(mfx3, "marginaleffects")
 dat <- data.table(mtcars)
 m <- feols(mpg ~ cyl * disp, dat)
 m1 <- slopes(m)
-m2 <- slopes(m, newdata = datagrid(disp = 0))  
+m2 <- slopes(m, newdata = datagrid(disp = 0))
 expect_inherits(m1, "marginaleffects")
 expect_inherits(m2, "marginaleffects")
 m1 <- comparisons(m)
-m2 <- comparisons(m, newdata = datagrid(disp = 0))  
+m2 <- comparisons(m, newdata = datagrid(disp = 0))
 expect_inherits(m1, "comparisons")
 expect_inherits(m2, "comparisons")
 
@@ -258,11 +259,11 @@ expect_false(anyNA(p$std.error))
 
 # Issue #705
 data(trade, package = "fixest")
-mod1 <- fepois(data = trade, Euros ~ 1 | Origin, offset = ~ log(dist_km))
-mod2 <- fepois(data = trade, Euros ~ 1 | Origin)
-
-mfx1 <- avg_slopes(mod1)
-mfx2 <- avg_slopes(mod2)
+dat <- trade
+mod1 <- fepois(data = dat, Euros ~ 1 | Origin, offset = ~ log(dist_km))
+mod2 <- fepois(data = dat, Euros ~ 1 | Origin)
+mfx1 <- avg_slopes(mod1, vcov = FALSE)
+mfx2 <- avg_slopes(mod2, vcov = FALSE)
 expect_inherits(mfx1, "slopes")
 expect_inherits(mfx2, "slopes")
 
@@ -311,6 +312,3 @@ expect_inherits(res, "comparisons") # should be slopes but can't figure out infe
 
 
 rm(list = ls())
-
-
-

inst/tinytest/test-pkg-survey.R

@@ -17,7 +17,7 @@ svyd <- survey::svydesign(
     data = fpc,
     nest = TRUE)
 mod <- survey::svyglm(x ~ nh, design = svyd)
-res <- slopes(mod)
+res <- slopes(mod, wts = "(weights)")
 mar <- suppressMessages(data.frame(margins(mod, unit_ses = TRUE)))
 expect_equivalent(res$estimate, as.numeric(mar$dydx_nh))
 expect_equivalent(res$std.error, as.numeric(mar$SE_dydx_nh), tolerance = 0.001)
@@ -39,15 +39,15 @@ expect_inherits(p, "data.frame")
 # Issue #1161
 dat <- "https://vincentarelbundock.github.io/Rdatasets/csv/AER/SmokeBan.csv"
 dat <- read.csv(dat, na.strings = c("*", ""))
-dat$weights <- runif(n=nrow(dat), min=1, max=100)
+dat$weights <- runif(n = nrow(dat), min = 1, max = 100)
 dat$smoker <- factor(dat$smoker)
-design1=svydesign(ids=~1, weights=~weights, data=dat)
-m <- suppressWarnings(svyglm(smoker ~ ban*education*gender+age, design=design1, family=binomial(), data = dat))
+design1 = svydesign(ids = ~1, weights = ~weights, data = dat)
+m <- suppressWarnings(svyglm(smoker ~ ban * education * gender + age, design = design1, family = binomial(), data = dat))
 cmp <- avg_comparisons(m,
-	variables = "education",
-	by = c("ban","gender"), 
-	wts = "weights",
-	hypothesis = ~reference) 
+    variables = "education",
+    by = c("ban", "gender"),
+    wts = "weights",
+    hypothesis = ~reference)
 expect_false(anyNA(cmp$estimate))
 
 
@@ -65,5 +65,3 @@ expect_false(anyNA(cmp$estimate))
 
 
 rm(list = ls())
-
-