stata tests

.Rbuildignore

@@ -2,3 +2,4 @@
 ^README\.Rmd$
 ^README\.html$
 ^\.github$
+^\.here$

DESCRIPTION

@@ -27,6 +27,7 @@ Suggests:
     fixest,
     ggeffects,
     haven,
+    here,
     ivreg,
     lme4,
     MASS,

tests/testthat/stata/clean.R

@@ -0,0 +1,50 @@
+library(haven)
+library(ivreg)
+library(betareg)
+library(MASS)
+library(data.table)
+library(testthat)
+library(readxl)
+
+results <- list()
+
+#  stats::glm
+tmp <- read.table("results/stats_glm_01.txt", sep = "\t", skip = 4) |>
+    setNames(c("term", "dydxstata", "std.errorstata")) |>
+    head(2)
+results[["stats_glm_01"]] <- tmp
+
+#  stats::lm
+tmp <- read.table("results/stats_lm_01.txt", sep = "\t", skip = 4) |>
+    setNames(c("term", "dydxstata", "std.errorstata")) |>
+    head(2)
+results[["stats_lm_01"]] <- tmp
+
+#  MASS::polr 
+tmp <- read.table("results/MASS_polr_01.txt", sep = "\t", skip = 4) |>
+    setNames(c("group", "dydxstata_x1", "std.errorstata_x1", "dydxstata_x2", "std.errorstata_x2")) |>
+    head(3) |>
+    transform(group = 2:4) |>
+    data.table()
+cols <- names(tmp)
+tmp[, (cols) := lapply(.SD, as.numeric)]
+tmp <- melt(tmp, id.vars = "group")
+tmp[, c("statistic", "term") := tstrsplit(variable, "_")]
+tmp[, variable := NULL]
+tmp <- dcast(tmp, group + term ~ statistic, value.var = "value")
+results[["MASS_polr_01"]] <- tmp
+
+#  ivreg::ivreg
+tmp <- read.table("results/ivreg_ivreg_01.txt", sep = "\t", skip = 4) |>
+    setNames(c("term", "dydxstata", "std.errorstata")) |>
+    head(2)
+results[["ivreg_ivreg_01"]] <- tmp
+
+#  betareg::betareg 
+tmp <- read.table("results/betareg_betareg_01.txt", sep = "\t", skip = 4) |>
+    setNames(c("term", "dydxstata", "std.errorstata")) |>
+    head(1)
+results[["betareg_betareg_01"]] <- tmp
+
+# save
+saveRDS(results, file = "stata.rds")

tests/testthat/stata/estimate.do

@@ -0,0 +1,41 @@
+cd ~/Dropbox/marginsxp_crosscheck
+
+
+* stats::glm
+clear
+use data/stats_glm_01.dta
+quiet logit y c.x1##c.x2
+quiet margins, dydx(x1 x2) post
+outreg2 using "results/stats_glm_01.xls", dec(10) excel replace noaster sideway noparen stats(coef se)
+
+
+* stats::lm
+clear
+use data/stats_lm_01.dta
+quiet reg y c.x1##c.x2
+quiet margins, dydx(x1 x2) post
+outreg2 using "results/stats_lm_01.xls", dec(10) excel replace noaster sideway noparen stats(coef se)
+
+
+* betareg::betareg
+clear
+use data/betareg_betareg_01.dta
+quiet betareg yield i.batch temp
+quiet margins, dydx(temp) post
+outreg2 using "results/betareg_betareg_01.xls", dec(10) excel replace noaster sideway noparen stats(coef se)
+
+
+* MASS::polr
+clear
+use data/MASS_polr_01.dta
+quiet ologit y x1 x2
+quiet margins, dydx(x1 x2) post
+outreg2 using "results/MASS_polr_01.xls", dec(10) excel replace noaster sideway noparen stats(coef se)
+
+
+* ivreg::ivreg
+clear
+use data/ivreg_ivreg_01.dta
+quiet ivregress 2sls Q D (P = D F A)
+quiet margins, dydx(P D) post
+outreg2 using "results/ivreg_ivreg_01.xls", dec(10) excel replace noaster sideway noparen stats(coef se)

tests/testthat/stata/generate.R

@@ -0,0 +1,54 @@
+library(haven)
+library(ivreg)
+library(betareg)
+
+################
+#  stats::glm  #
+################
+set.seed(1024)
+N <- 100
+dat <- data.frame(x1 = rnorm(N), x2 = rnorm(N))
+dat$y <- plogis(dat$x1 + dat$x2 + dat$x1 * dat$x2)
+dat$y <- rbinom(N, 1, dat$y)
+haven::write_dta(dat, path = "data/stats_glm_01.dta")
+
+
+###############
+#  stats::lm  #
+###############
+set.seed(1024)
+N <- 100
+dat <- data.frame(x1 = rnorm(N), x2 = rnorm(N))
+dat$y <- dat$x1 + dat$x2 + dat$x1 * dat$x2 + rnorm(N)
+haven::write_dta(dat, path = "data/stats_lm_01.dta")
+
+
+################
+#  MASS::polr  #
+################
+set.seed(1024)
+N <- 1000
+dat <- data.frame(x1 = rnorm(N), x2 = rnorm(N))
+dat$y <- dat$x1 + dat$x2 + dat$x1 * dat$x2 + rnorm(N)
+dat$y <- cut(dat$y, breaks = 4)
+dat$y <- factor(as.numeric(dat$y))
+haven::write_dta(dat, path = "data/MASS_polr_01.dta")
+
+
+##################
+#  ivreg::ivreg  #
+##################
+haven::write_dta(ivreg::Kmenta, path = "data/ivreg_ivreg_01.dta")
+
+
+######################
+#  betareg::betareg  #
+######################
+data("GasolineYield", package = "betareg")
+haven::write_dta(GasolineYield, path = "data/betareg_betareg_01.dta")
+
+
+####################
+#  fixest::fixest  #
+####################
+haven::write_dta(mtcars, path = "data/fixest_fixest_01.dta")

tests/testthat/test-dydx_MASS.R

@@ -1,19 +1,33 @@
 skip_if_not_installed("MASS")
 
 library("margins")
+library("haven")
+library("data.table")
 
-test_that("polr: test against margins", {
+test_that("polr vs. margins", {
     skip("no idea why this fails")
     tmp <- data.frame(mtcars)
     tmp$carb <- as.factor(tmp$carb)
     mod <- MASS::polr(carb ~ hp + am + mpg, data = tmp) 
     res <- marginsxp(mod, variance = NULL)
     mar <- margins(mod)
-
     expect_s3_class(res, "data.frame")
     expect_equal(dim(res), c(480, 8))
-
     # TODO: not supported yet
     expect_error(marginsxp(mod, variance = NULL), regexp = "group_name")
     expect_error(marginsxp(mod, group_names = "1"), regexp = "not yet supported")
 })
+
+test_that("polr vs. Stata", {
+    stata <- readRDS(test_path("stata/stata.rds"))[["MASS_polr_01"]]
+    dat <- read_dta(test_path("stata/data/MASS_polr_01.dta"))
+    mod <- MASS::polr(factor(y) ~ x1 + x2, data = dat)
+    mfx <- marginsxp(mod, 
+                     variance = NULL, 
+                     prediction_type = "probs")
+    mfx <- data.table(mfx)
+    ame <- mfx[, list(dydx = mean(dydx)), by = c("group", "term")][
+               , group := as.numeric(group)]
+    ame <- merge(ame, stata, by = c("group", "term"))
+    expect_equal(ame$dydx, ame$dydxstata, tolerance = 0.001)
+})

tests/testthat/test-dydx_betareg.R

@@ -1,6 +1,9 @@
 skip_if_not_installed("betareg")
 
 library("margins")
+library("haven")
+library("betareg")
+library("data.table")
 
 test_that("betareg", {
     data("GasolineYield", package = "betareg")
@@ -11,3 +14,14 @@ test_that("betareg", {
     })
     expect_true(cor(as.numeric(mar$temp), res$temp, use = "complete.obs") > .99999)
 })
+
+
+test_that("betareg vs. Stata", {
+    stata <- readRDS(test_path("stata/stata.rds"))[["betareg_betareg_01"]]
+    dat <- read_dta(test_path("stata/data/betareg_betareg_01.dta"))
+    mod <- betareg::betareg(yield ~ factor(batch) + temp, data = dat)
+    mfx <- suppressWarnings(data.table(marginsxp(mod, variance = NULL)))
+    ame <- mfx[, list(dydx = mean(dydx)), by = "term"]
+    ame <- merge(ame, stata)
+    expect_equal(ame$dydx, ame$dydxstata, tolerance = 0.00001)
+})

tests/testthat/test-dydx_ivreg.R

@@ -1,6 +1,9 @@
 skip_if_not_installed("ivreg")
 
 library("margins")
+library("haven")
+library("data.table")
+library("ivreg")
 
 test_that("ivreg: vs. margins", {
     data(Kmenta, package = "ivreg")
@@ -9,3 +12,14 @@ test_that("ivreg: vs. margins", {
     mar <- data.frame(margins(mod, unit_ses = TRUE))
     marginsxp:::test_against_margins(res, mar, tolerance = .01)
 })    
+
+test_that("ivreg: vs. Stata", {
+    dat <- read_dta(test_path("stata/data/ivreg_ivreg_01.dta"))
+    stata <- readRDS(test_path("stata/stata.rds"))[["ivreg_ivreg_01"]]
+    mod <- ivreg::ivreg(Q ~ P + D | D + F + A, data = dat)
+    mfx <- marginsxp(mod)
+    mfx <- data.table(mfx)
+    ame <- mfx[, list(dydx = mean(dydx), std.error = mean(std.error)), by = "term"]
+    ame <- merge(ame, stata, by = "term")
+    expect_equal(ame$dydx, ame$dydxstata, tolerance = 0.0001)
+})

tests/testthat/test-dydx_stats.R

@@ -1,4 +1,6 @@
 library("margins")
+library("haven")
+library("data.table")
 
 test_that("glm", {
     set.seed(1024)
@@ -17,6 +19,28 @@ test_that("glm", {
 })
 
 
+test_that("glm vs. Stata", {
+    stata <- readRDS(test_path("stata/stata.rds"))[["stats_glm_01"]]
+    dat <- read_dta(test_path("stata/data/stats_glm_01.dta"))
+    mod <- glm(y ~ x1 * x2, family = binomial, data = dat)
+    mfx <- data.table(marginsxp(mod))
+    ame <- mfx[, list(dydx = mean(dydx), std.error = mean(std.error)), by = "term"]
+    ame <- merge(ame, stata)
+    expect_equal(ame$dydx, ame$dydxstata, tolerance = 0.00001)
+})
+
+
+test_that("lm vs. Stata", {
+    stata <- readRDS(test_path("stata/stata.rds"))[["stats_lm_01"]]
+    dat <- read_dta(test_path("stata/data/stats_lm_01.dta"))
+    mod <- lm(y ~ x1 * x2, data = dat)
+    mfx <- data.table(marginsxp(mod))
+    ame <- mfx[, list(dydx = mean(dydx), std.error = mean(std.error)), by = "term"]
+    ame <- merge(ame, stata)
+    expect_equal(ame$dydx, ame$dydxstata, tolerance = 0.00001)
+})
+
+
 test_that("lm with interactions", {
     counterfactuals <- expand.grid(hp = 100, am = 0:1)
     mod <- lm(mpg ~ hp * am, data = mtcars)
@@ -27,14 +51,14 @@ test_that("lm with interactions", {
 })
 
 
-test_that("TODO: loess vcov error is raised too early to catch", {
+test_that("vcov(loess) does not exist", {
     mod <- loess(mpg ~ wt, data = mtcars)
     expect_error(marginsxp(mod), regexp = "not yet supported")
 })
 
 
 test_that("loess error", {
-    skip("not sure why I get different results for loess")
+    skip("loess produces different results under margins and marginsxp")
     mod <- loess(mpg ~ wt, data = mtcars)
     res <- marginsxp(mod, variance = NULL)
     mar <- data.frame(margins(mod))