add glance helper (#823)

R/robust-glmrob-tidiers.R

@@ -65,12 +65,13 @@ augment.glmRob <- function(x, ...) {
 #'
 glance.glmRob <- function(x, ...) {
   s <- summary(x)
-  ret <- tibble(
+
+  as_glance_tibble(
     deviance = x$deviance,
     sigma = stats::sigma(x),
     null.deviance = x$null.deviance,
     df.residual = stats::df.residual(x),
-    nobs = stats::nobs(x)
+    nobs = stats::nobs(x),
+    na_types = c(rep(NA_real_, 3), rep(NA_integer_, 2))
   )
-  ret
 }

R/robustbase-lmrob-tidiers.R

@@ -96,9 +96,11 @@ augment.lmrob <- function(x, data = model.frame(x), newdata = NULL, se_fit = FAL
 #' @seealso [robustbase::lmrob()]
 glance.lmrob <- function(x, ...) {
   s <- summary(x)
-  tibble(
+
+  as_glance_tibble(
     r.squared = s$r.squared,
     sigma = s$sigma,
-    df.residual = x$df.residual
+    df.residual = x$df.residual,
+    na_types = c(NA_real_, NA_real_, NA_integer_)
   )
 }

R/utilities.R

@@ -121,6 +121,26 @@ has_rownames <- function(df) {
   any(rownames(df) != as.character(1:nrow(df)))
 }
 
+# A function that, given named arguments, will make a one-row
+# tibble, switching out NULLs for the appropriate NA type
+as_glance_tibble <- function(..., na_types) {
+
+  cols <- list(...)
+
+  if (length(cols) != length(na_types)) {
+    stop(
+      "The number of columns provided does not match the number of ",
+      "column types provided."
+    )
+  }
+
+  entries <- purrr::map2(cols, 
+                         na_types, 
+                         function(.x, .y) {if (is.null(.x)) .y else .x})
+
+  tibble::as_tibble_row(entries)
+
+}
 
 # strip rownames from a data frame
 unrowname <- function(x) {

tests/testthat/test-robustbase.R

@@ -9,6 +9,18 @@ library(robustbase)
 fit <- lmrob(mpg ~ wt, data = mtcars)
 fit2 <- glmrob(am ~ wt, data = mtcars, family = "binomial")
 
+clotting <- data.frame(
+  u = c(5, 10, 15, 20, 30, 40, 60, 80, 100),
+  lot1 = c(118, 58, 42, 35, 27, 25, 21, 19, 18),
+  lot2 = c(69, 35, 26, 21, 18, 16, 13, 12, 12)
+)
+
+fit_rd <- robustbase::glmrob(
+  formula = lot1 ~ log(u),
+  data = clotting,
+  family = Gamma
+)
+
 test_that("robustbase tidier arguments", {
   check_arguments(tidy.lmrob)
   check_arguments(glance.lmrob)
@@ -31,6 +43,9 @@ test_that("tidy.lmrob", {
 test_that("glance.lmrob", {
   gl <- glance(fit)
   check_glance_outputs(gl)
+
+  gl_rd <- glance(fit_rd)
+  check_glance_outputs(gl_rd)
 })
 
 test_that("augment.lmrob", {