Add nobs column to glance output, use custom logic instead of finish_…

…glance() (#597)

DESCRIPTION

@@ -43,7 +43,8 @@ Authors@R: c(
     person("Matt", "Lehman", role = "ctb"),
     person("Bill", "Denney", email = "wdenney@humanpredictions.com", role = "ctb", comment = c(ORCID = "0000-0002-5759-428X")),
     person("Nic", "Crane", role = "ctb"),
-    person("Andrew", "Bates", role = "ctb"))
+    person("Andrew", "Bates", role = "ctb"),
+    person("Vincent", "Arel-Bundock", email = "vincent.arel-bundock@umontreal.ca", role = "ctb", comment = c(ORCID = "0000-0003-2042-7063")))
 Description: Summarizes key information about statistical objects in tidy
     tibbles. This makes it easy to report results, create plots and consistently
     work with large numbers of models at once. Broom provides three verbs that
@@ -204,6 +205,7 @@ Collate:
     'muhaz-tidiers.R'
     'multcomp-tidiers.R'
     'nnet-tidiers.R'
+    'nobs.R'
     'orcutt-tidiers.R'
     'ordinal-tidiers.R'
     'plm-tidiers.R'

NAMESPACE

@@ -195,7 +195,6 @@ S3method(tidy,zoo)
 export(augment)
 export(augment_columns)
 export(confint_tidy)
-export(finish_glance)
 export(fix_data_frame)
 export(glance)
 export(tidy)

NEWS.md

@@ -38,7 +38,7 @@ TODO: sort out what happens to `glance.aov()`
 - `tidy_optim()` now returns the standard error provides the standard error if the Hessian is present. (#529 by @billdenney) (TODO: think about this)
 - `glance.biglm()` now returns a `df.residual` column
 - `tidy.htest()` column names are now run through `make.names()` to ensure syntactic correctness (#549 by @karissawhiting) (TODO: use tidyverse name repair?)
-
+- Many `glance()` methods now return the number of observations in a `nobs` column, which is typically the rightmost column.
 
 ### Name changes for consistency
 
@@ -53,6 +53,7 @@ TODO: sort out what happens to `glance.aov()`
 - Bug fix for `tidy.mlm()` when passed `quick = TRUE` (#539 by @MatthieuStigler)
 - Bug fix for `tidy.polr()` when passed `conf.int = TRUE` (#498)
 - Bug fix in `glance.lavaan()` (#577)
+>>>>>>> upstream/master
 
 ## Deprecations
 

R/aer-tidiers.R

@@ -85,6 +85,7 @@ augment.ivreg <- function(x, data = model.frame(x), newdata = NULL, ...) {
 #'   "sigma",
 #'   "df",
 #'   "df.residual",
+#'   "nobs",
 #'   "statistic.Sargan",
 #'   "p.value.Sargan",
 #'   "statistic.Wu.Hausman",
@@ -112,6 +113,8 @@ glance.ivreg <- function(x, diagnostics = FALSE, ...) {
       df = df[1]
     )
   )
+  ret$df.residual <- df.residual(x)
+  ret$nobs <- stats::nobs(x)
 
   if (diagnostics) {
     diag <- with(s,
@@ -126,6 +129,7 @@ glance.ivreg <- function(x, diagnostics = FALSE, ...) {
     )
     ret <- bind_cols(ret, diag)
   }
+
+  as_tibble(ret, rownames = NULL)
 
-  finish_glance(ret, x)
 }

R/betareg-tidiers.R

@@ -91,7 +91,8 @@ augment.betareg <- function(x, data = model.frame(x), newdata = NULL,
 #'   "logLik", 
 #'   "AIC",
 #'   "BIC",
-#'   "df.residual"
+#'   "df.residual",
+#'   "nobs"
 #' )
 #' 
 #' @seealso [glance()], [betareg::betareg()]
@@ -100,8 +101,12 @@ glance.betareg <- function(x, ...) {
   s <- summary(x)
   ret <- tibble(
     pseudo.r.squared = s$pseudo.r.squared,
-    df.null = s$df.null
+    df.null = s$df.null,
+    logLik = as.numeric(stats::logLik(x)),
+    AIC = stats::AIC(x),
+    BIC = stats::BIC(x),
+    df.residual = stats::df.residual(x),
+    nobs = stats::nobs(x)
   )
-  ret <- finish_glance(ret, x)
   as_tibble(ret)
 }

R/biglm-tidiers.R

@@ -64,16 +64,21 @@ tidy.biglm <- function(x, conf.int = FALSE, conf.level = .95,
 #' @inherit tidy.biglm params examples
 #' @template param_unused_dots
 #' 
-#' @evalRd return_glance("r.squared", "AIC", "deviance", "df.residual")
+#' @evalRd return_glance("r.squared", 
+#                        "AIC", 
+#'                       "deviance", 
+#'                       "df.residual",
+#'                       "nobs")
 #'
 #' @export
 #' @family biglm tidiers
 #' @seealso [glance()], [biglm::biglm()], [biglm::bigglm()]
 glance.biglm <- function(x, ...) {
-  # biglm objects have `df.resid` instead of `df.residual`, so 
-  # `finish_glance()` will not work with default biglm fields. 
-  if (sum(names(x) == "df.resid") == 1) {
-    x$df.residual <- x$df.resid
-  }
-  finish_glance(tibble(r.squared = summary(x)$rsq), x)
+  s <- summary(x)
+  ret <- tibble(r.squared = s$rsq,
+                AIC = stats::AIC(x),
+                deviance = stats::deviance(x),
+                df.residual = x$df.resid,
+                nobs = stats::nobs(x))
+  ret 
 }

R/gam-tidiers.R

@@ -43,7 +43,8 @@ tidy.Gam <- function(x, ...) {
 #'   "AIC",
 #'   "BIC",
 #'   "deviance",
-#'   "df.residual"
+#'   "df.residual",
+#'   "nobs"
 #' )
 #' 
 #' @details Glance at `gam` objects created by calls to [mgcv::gam()] with
@@ -54,6 +55,12 @@ tidy.Gam <- function(x, ...) {
 #' @seealso [glance()], [gam::gam()]
 glance.Gam <- function(x, ...) {
   s <- summary(x)
-  ret <- tibble(df = s$df[1])
-  finish_glance(ret, x)
+  ret <- tibble(df = s$df[1],
+                logLik = as.numeric(stats::logLik(x)),
+                AIC = stats::AIC(x),
+                BIC = stats::BIC(x),
+                deviance = stats::deviance(x),
+                df.residual = stats::df.residual(x),
+                nobs = stats::nobs(x))
+  ret
 }

R/glmnet-cv-glmnet-tidiers.R

@@ -91,11 +91,13 @@ tidy.cv.glmnet <- function(x, ...) {
 #' 
 #' @inherit tidy.cv.glmnet params examples
 #' 
-#' @evalRd return_glance("lambda.min", "lambda.1se")
+#' @evalRd return_glance("lambda.min", "lambda.1se", "nobs")
 #'
 #' @export
 #' @seealso [glance()], [glmnet::cv.glmnet()]
 #' @family glmnet tidiers
 glance.cv.glmnet <- function(x, ...) {
-  tibble(lambda.min = x$lambda.min, lambda.1se = x$lambda.1se)
+  tibble(lambda.min = x$lambda.min, 
+         lambda.1se = x$lambda.1se,
+         nobs = stats::nobs(x))
 }

R/glmnet-glmnet-tidiers.R

@@ -94,11 +94,13 @@ tidy.glmnet <- function(x, return_zeros = FALSE, ...) {
 #' 
 #' @inherit tidy.glmnet params examples
 #' 
-#' @evalRd return_glance("nulldev", "npasses")
+#' @evalRd return_glance("nulldev", "npasses", "nobs")
 #'
 #' @export
 #' @family glmnet tidiers
 #' @seealso [glance()], [glmnet::glmnet()]
 glance.glmnet <- function(x, ...) {
-  tibble(nulldev = x$nulldev, npasses = x$npasses)
+  tibble(nulldev = x$nulldev, 
+         npasses = x$npasses,
+         nobs = stats::nobs(x))
 }

R/gmm-tidiers.R

@@ -116,14 +116,22 @@ tidy.gmm <- function(x, conf.int = FALSE, conf.level = .95,
 #' 
 #' @inherit tidy.gmm params examples
 #'
-#' @evalRd return_glance("df", "statistic", "p.value", "df.residual")
+#' @evalRd return_glance("df", 
+#'                       "statistic", 
+#'                       "p.value", 
+#'                       "df.residual", 
+#'                       "nobs")
 #'
 #' @export
 #' @family gmm tidiers
 #' @seealso [glance()], [gmm::gmm()]
 glance.gmm <- function(x, ...) {
   s <- gmm::summary.gmm(x)
   st <- suppressWarnings(as.numeric(s$stest$test))
-  ret <- tibble(df = x$df, statistic = st[1], p.value = st[2])
-  finish_glance(ret, x)
+  ret <- tibble(df = x$df, 
+                statistic = st[1], 
+                p.value = st[2],
+                df.residual = stats::df.residual(x),
+                nobs = stats::nobs(x))
+  ret
 }

R/lfe-tidiers.R

@@ -170,7 +170,8 @@ augment.felm <- function(x, data = model.frame(x), ...) {
 #'   "statistic",
 #'   "p.value",
 #'   "df",
-#'   "df.residual"
+#'   "df.residual",
+#'   "nobs"
 #' )
 #'
 #' @export
@@ -193,7 +194,8 @@ glance.felm <- function(x, ...) {
       statistic = fstat,
       p.value = pval,
       df = df[1],
-      df.residual = rdf
+      df.residual = rdf,
+      nobs = stats::nobs(x)
   ))
-  finish_glance(ret, x)
+  ret
 }

R/lmodel2-tidiers.R

@@ -68,7 +68,8 @@ tidy.lmodel2 <- function(x, ...) {
 #'   "r.squared",
 #'   "p.value",
 #'   theta = "Angle between OLS lines `lm(y ~ x)` and `lm(x ~ y)`",
-#'   H = "H statistic for computing confidence interval of major axis slope"
+#'   H = "H statistic for computing confidence interval of major axis slope",
+#'   "nobs"
 #' )
 #'
 #' @export
@@ -80,6 +81,7 @@ glance.lmodel2 <- function(x, ...) {
     r.squared = x$rsquare,
     theta = x$theta,
     p.value = x$P.param,
-    H = x$H
+    H = x$H,
+    nobs = stats::nobs(x)
   )
 }

R/mass-fitdistr-tidiers.R

@@ -35,11 +35,16 @@ tidy.fitdistr <- function(x, ...) {
 #' 
 #' @inherit tidy.fitdistr params examples
 #'
-#' @evalRd return_glance("n", "logLik", "AIC", "BIC")
+#' @evalRd return_glance("logLik", "AIC", "BIC", "nobs")
 #'
 #' @export
 #' @family fitdistr tidiers
 #' @seealso [tidy()], [MASS::fitdistr()]
 glance.fitdistr <- function(x, ...) {
-  finish_glance(data.frame(n = x$n), x)
+  ret <- tibble(logLik = stats::logLik(x),
+                AIC = stats::AIC(x),
+                BIC = stats::BIC(x),
+                nobs = stats::nobs(x)
+                )
+  ret
 }

R/mass-polr-tidiers.R

@@ -1,6 +1,13 @@
 
 #' @rdname ordinal_tidiers
 #' @export
+#' @examples
+#' 
+#' library(MASS)
+#' data(housing)
+#' mod <- polr(Sat ~ Infl + Type + Cont, weights = Freq, data = housing)    
+#' tidy(mod)
+#' glance(mod)
 tidy.polr <- function(x, conf.int = FALSE, conf.level = .95,
                       exponentiate = FALSE, quick = FALSE, ...) {
   if (quick) {
@@ -51,9 +58,26 @@ process_polr <- function(ret, x, conf.int = FALSE, conf.level = .95,
 
 
 #' @rdname ordinal_tidiers
+#' @evalRd return_glance(
+#'  "edf",
+#'  "logLik",
+#'  "AIC",
+#'  "BIC",
+#'  "deviance",
+#'  "df.residual",
+#'  "nobs"
+#' )
 #' @export
 glance.polr <- function(x, ...) {
-  finish_glance(tibble(edf = x$edf), x)
+  ret <- tibble(edf = x$edf,
+                logLik = as.numeric(stats::logLik(x)),
+                AIC = stats::AIC(x),
+                BIC = stats::BIC(x),
+                deviance = stats::deviance(x),
+                df.residual = stats::df.residual(x),
+                nobs = stats::nobs(x)
+                )
+  ret
 }
 
 #' @rdname ordinal_tidiers

R/mass-rlm-tidiers.R

@@ -10,7 +10,8 @@
 #'   "logLik",
 #'   "AIC",
 #'   "BIC",
-#'   "deviance"
+#'   "deviance",
+#'   "nobs"
 #' )
 #'
 #' @details For tidiers for models from the \pkg{robust} package see
@@ -31,10 +32,15 @@
 #' @seealso [glance()], [MASS::rlm()]
 glance.rlm <- function(x, ...) {
   s <- summary(x)
-  ret <- tibble(sigma = s$sigma, converged = x$converged)
-  ret <- finish_glance(ret, x)
-  # remove df.residual, which is always set to NA in rlm objects
-  dplyr::select(ret, -df.residual)
+  ret <- tibble(sigma = s$sigma, 
+                converged = x$converged,
+                logLik = stats::logLik(x),
+                AIC = stats::AIC(x),
+                BIC = stats::BIC(x),
+                deviance = stats::deviance(x),
+                nobs = stats::nobs(x))
+  ret
+  # df.residual is always set to NA in rlm objects
 }
 
 # confint.lm gets called on rlm objects. should use the default instead.

R/mclust-tidiers.R

@@ -34,7 +34,7 @@
 #'     x1 = purrr::map2(num_points, x1, rnorm),
 #'     x2 = purrr::map2(num_points, x2, rnorm)
 #'   ) %>% 
-#'   select(-num_points, -cluster) %>%
+#'   dplyr::select(-num_points, -cluster) %>%
 #'   tidyr::unnest(x1, x2)
 #'
 #' m <- mclust::Mclust(points)
@@ -103,28 +103,29 @@ augment.Mclust <- function(x, data = NULL, ...) {
 #' @inherit tidy.Mclust params examples
 #'
 #' @evalRd return_glance(
-#'   "n",
 #'   "BIC",
 #'   "logLik",
 #'   "df",
 #'   model = "A string denoting the model type with optimal BIC",
 #'   G = "Number mixture components in optimal model",
 #'   hypvol = "If the other model contains a noise component, the 
-#'     value of the hypervolume parameter. Otherwise `NA`."
+#'     value of the hypervolume parameter. Otherwise `NA`.",
+#'   nobs
 #' )
 #'
 #' @export
 glance.Mclust <- function(x, ...) {
-  with(
+  ret <- with(
     x,
     tibble(
       model = modelName,
-      n,
       G,
       BIC = bic, 
       logLik = loglik,
       df,
       hypvol
     )
   )
+  ret$nobs <- stats::nobs(x)
+  ret
 }