Add save argument to preserve original model object as attribute.

.Rbuildignore

@@ -32,3 +32,5 @@
 ^vignettes/.+\.pdf$
 ^vignettes/.+\.tex$
 ^data-raw$
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -20,3 +20,4 @@ ignore/
 ignore/*
 revdep/
 revdep/*
+.Rproj.user

DESCRIPTION

@@ -18,7 +18,11 @@ Authors@R: c(person("Thomas J.", "Leeper",
              person("Jacob A.", "Long", 
                     role = c("ctb"),
                     email = "[email protected]",
-                    comment = c(ORCID = "0000-0002-1582-6214"))
+                    comment = c(ORCID = "0000-0002-1582-6214")),
+             person("Grant R.", "McDermott", 
+                    role = c("ctb"),
+                    email = "[email protected]",
+                    comment = c(ORCID = "0000-0001-7883-8573"))
              )
 URL: https://github.com/leeper/margins
 BugReports: https://github.com/leeper/margins/issues
@@ -48,4 +52,4 @@ Enhances:
     survey
 ByteCompile: true
 VignetteBuilder: knitr
-RoxygenNote: 7.1.0
+RoxygenNote: 7.1.1

R/margins.R

@@ -19,6 +19,7 @@
 #' @param iterations If \code{vce = "bootstrap"}, the number of bootstrap iterations. If \code{vce = "simulation"}, the number of simulated effects to draw. Ignored otherwise.
 #' @param unit_ses If \code{vce = "delta"}, a logical specifying whether to calculate and return unit-specific marginal effect variances. This calculation is time consuming and the information is often not needed, so this is set to \code{FALSE} by default.
 #' @param eps A numeric value specifying the \dQuote{step} to use when calculating numerical derivatives.
+#' @param save Logical indicating whether the original model object itself should be saved as an attribute. (This may be useful for further processing of margins objects, e.g., as part of model summaries.)
 #' @param \dots Arguments passed to methods, and onward to \code{\link{dydx}} methods and possibly further to \code{\link[prediction]{prediction}} methods. This can be useful, for example, for setting \code{type} (predicted value type), \code{eps} (precision), or \code{category} (category for multi-category outcome models), etc.
 #' @details Methods for this generic return a \dQuote{margins} object, which is a data frame consisting of the original data, predicted values and standard errors thereof, estimated marginal effects from the model \code{model} (for all variables used in the model, or the subset specified by \code{variables}), along with attributes describing various features of the marginal effects estimates.
 #' 

R/margins_betareg.R

@@ -11,6 +11,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -63,5 +64,6 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = FALSE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }

R/margins_clm.R

@@ -8,6 +8,7 @@ function(model,
          type = c("response", "link"),
          vce = "none",
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -54,5 +55,6 @@ function(model,
               vcov = NULL,
               jacobian = NULL,
               weighted = FALSE,
-              iterations = NULL)
+              iterations = NULL,
+              object = if (save) model else NULL)
 }

R/margins_default.R

@@ -11,6 +11,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -59,6 +60,7 @@ function(model,
               type = type,
               call = if ("call" %in% names(model)) model[["call"]] else NULL,
               model_class = class(model),
+              object = if (save) model else NULL,
               vce = vce,
               vcov = vc,
               jacobian = jac,

R/margins_glm.R

@@ -11,6 +11,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -67,5 +68,6 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = FALSE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }

R/margins_loess.R

@@ -7,6 +7,7 @@ function(model,
          at = NULL, 
          vce = "none", 
          eps = 1e-7,
+         save = FALSE,
          ...){
 
     # setup data
@@ -54,5 +55,6 @@ function(model,
               vcov = NULL,
               jacobian = NULL,
               weighted = FALSE,
-              iterations = NULL)
+              iterations = NULL,
+              object = if (save) model else NULL)
 }

R/margins_merMod.R

@@ -11,6 +11,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -61,7 +62,8 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = FALSE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }
 
 #' @rdname margins

R/margins_multinom.R

@@ -12,6 +12,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -74,5 +75,6 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = FALSE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }

R/margins_nnet.R

@@ -7,6 +7,7 @@ function(model,
          at = NULL, 
          vce = "none",
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -49,5 +50,6 @@ function(model,
               vcov = NULL,
               jacobian = NULL,
               weighted = FALSE,
-              iterations = NULL)
+              iterations = NULL,
+              object = if (save) model else NULL)
 }

R/margins_polr.R

@@ -12,6 +12,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # match.arg()
@@ -74,5 +75,6 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = FALSE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }

R/margins_svyglm.R

@@ -12,6 +12,7 @@ function(model,
          iterations = 50L, # if vce == "bootstrap" or "simulation"
          unit_ses = FALSE,
          eps = 1e-7,
+         save = FALSE,
          ...) {
 
     # require survey
@@ -81,5 +82,6 @@ function(model,
               vcov = vc,
               jacobian = jac,
               weighted = if (is.null(wts)) FALSE else TRUE,
-              iterations = if (vce == "bootstrap") iterations else NULL)
+              iterations = if (vce == "bootstrap") iterations else NULL,
+              object = if (save) model else NULL)
 }

tests/testthat/tests-core.R

@@ -96,6 +96,36 @@ test_that("confint() for 'margins' object", {
     expect_true(inherits(confint(m), "matrix"), label = "confint() for margins")
 })
 
+context("Saving model object")
+test_that("save = TRUE works", {
+    x <- lm(mpg ~ wt * hp, data = mtcars)
+    m <- margins(x, save = TRUE)
+    x_df <- with(summary(x),
+                 data.frame(
+                     r.squared = r.squared,
+                    adj.r.squared = adj.r.squared,
+                    sigma = sigma,
+                    logLik = as.numeric(stats::logLik(x)),
+                    AIC = stats::AIC(x),
+                    BIC = stats::BIC(x),
+                    deviance = stats::deviance(x),
+                    df.residual = df.residual(x),
+                    nobs = stats::nobs(x)
+                    ))
+    m_df <- with(summary(attr(m, 'object')),
+                 data.frame(
+                     r.squared = r.squared,
+                     adj.r.squared = adj.r.squared,
+                     sigma = sigma,
+                     logLik = as.numeric(stats::logLik(attr(m, 'object'))),
+                     AIC = stats::AIC(attr(m, 'object')),
+                     BIC = stats::BIC(attr(m, 'object')),
+                     deviance = stats::deviance(attr(m, 'object')),
+                     df.residual = df.residual(attr(m, 'object')),
+                     nobs = stats::nobs(attr(m, 'object'))
+                     ))
+    expect_equal(x_df, m_df, label = "Original lm object correctly saved as attribute")
+})
 
 context("Variance tests")
 test_that("minimum test of variance calculations", {