Merge commit '637a9b095d02d4263dfac2795099705f938cbc12'

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: broom.helpers
 Title: Helpers for Model Coefficients Tibbles
-Version: 1.13.0.9000
+Version: 1.14.0.9000
 Authors@R: c(
     person("Joseph", "Larmarange", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-7097-700X")),
@@ -29,6 +29,7 @@ Imports:
     tibble,
     tidyr
 Suggests: 
+    betareg,
     biglm,
     biglmm,
     brms (>= 2.13.0),
@@ -68,6 +69,7 @@ Suggests:
     parsnip,
     patchwork,
     plm,
+    pscl,
     rmarkdown,
     rstanarm,
     scales,

NAMESPACE

@@ -22,8 +22,11 @@ S3method(model_get_coefficients_type,negbin)
 S3method(model_get_coefficients_type,polr)
 S3method(model_get_coefficients_type,svyolr)
 S3method(model_get_coefficients_type,tidycrr)
+S3method(model_get_contrasts,betareg)
 S3method(model_get_contrasts,default)
+S3method(model_get_contrasts,hurdle)
 S3method(model_get_contrasts,model_fit)
+S3method(model_get_contrasts,zeroinfl)
 S3method(model_get_model,default)
 S3method(model_get_model,mira)
 S3method(model_get_model_frame,biglm)
@@ -33,6 +36,7 @@ S3method(model_get_model_frame,fixest)
 S3method(model_get_model_frame,model_fit)
 S3method(model_get_model_frame,survreg)
 S3method(model_get_model_matrix,LORgee)
+S3method(model_get_model_matrix,betareg)
 S3method(model_get_model_matrix,biglm)
 S3method(model_get_model_matrix,brmsfit)
 S3method(model_get_model_matrix,clm)
@@ -54,12 +58,16 @@ S3method(model_get_n,survreg)
 S3method(model_get_n,tidycrr)
 S3method(model_get_nlevels,default)
 S3method(model_get_offset,default)
+S3method(model_get_pairwise_contrasts,betareg)
 S3method(model_get_pairwise_contrasts,default)
+S3method(model_get_pairwise_contrasts,hurdle)
+S3method(model_get_pairwise_contrasts,zeroinfl)
 S3method(model_get_response,default)
 S3method(model_get_response,glm)
 S3method(model_get_response,glmerMod)
 S3method(model_get_response,model_fit)
 S3method(model_get_response_variable,default)
+S3method(model_get_terms,betareg)
 S3method(model_get_terms,brmsfit)
 S3method(model_get_terms,default)
 S3method(model_get_terms,glmmTMB)
@@ -174,6 +182,7 @@ export(tidy_plus_plus)
 export(tidy_remove_intercept)
 export(tidy_select_variables)
 export(tidy_with_broom_or_parameters)
+export(tidy_zeroinfl)
 export(variables_to_contrast)
 export(variables_to_predict)
 export(vars)

NEWS.md

@@ -2,7 +2,19 @@
 
 **New features**
 
+- new `tidy_post_fun` argument in `tidy_plus_plus()` (#235)
+
+**Fix**
+
+- fix in `supported_models`
+
+# broom.helpers 1.14.0
+
+**New features**
+
 - support for `MASS::contr.sdif()` contrasts (#230)
+- support for `pscl::zeroinfl()` and `pscl::hurdle()` models (#232)
+- support for `betareg::betareg()` models (#234)
 
 **Fix**
 

R/broom.helpers-package.R

@@ -50,7 +50,8 @@ utils::globalVariables(c(".", "where"))
     dplyr::select(
       dplyr::any_of(
         c(
-          "y.level", "term", "original_term", "variable", "var_label", "var_class", "var_type",
+          "y.level", "component", "term", "original_term", "variable",
+          "var_label", "var_class", "var_type",
           "var_nlevels", "header_row", "contrasts", "contrasts_type",
           "reference_row", "label", "n_obs", "n_event", "exposure"
         )
@@ -68,7 +69,7 @@ utils::globalVariables(c(".", "where"))
       "exponentiate", "conf.level", "coefficients_type", "coefficients_label",
       "variable_labels", "term_labels", "N_obs", "N_event", "Exposure",
       "force_contr.treatment", "skip_add_reference_rows",
-      "find_missing_interaction_terms"
+      "find_missing_interaction_terms", "component"
     )
   )
   .attributes[.attributes_names]

R/custom_tidiers.R

@@ -1,12 +1,15 @@
 #' Tidy a model with parameters package
 #'
-#' Use `parameters::model_parameters()` to tidy a model and apply
+#' Use [parameters::model_parameters()] to tidy a model and apply
 #' `parameters::standardize_names(style = "broom")` to the output
 #' @param x a model
 #' @param conf.int logical indicating whether or not to include a confidence
 #' interval in the tidied output
 #' @param conf.level the confidence level to use for the confidence interval
-#' @param ... additional parameters passed to `parameters::model_parameters()`
+#' @param ... additional parameters passed to [parameters::model_parameters()]
+#' @note
+#' For [betareg::betareg()], the component column in the results is standardized
+#' with [broom::tidy()], using `"mean"` and `"precision"` values.
 #' @examplesIf interactive()
 #' if (.assert_package("parameters", boolean = TRUE)) {
 #'   lm(Sepal.Length ~ Sepal.Width + Species, data = iris) %>%
@@ -16,11 +19,21 @@
 #' @family custom_tieders
 tidy_parameters <- function(x, conf.int = TRUE, conf.level = .95, ...) {
   .assert_package("parameters", fn = "broom.helpers::tidy_parameters()")
-
+  args <- list(...)
   if (!conf.int) conf.level <- NULL
+  args$ci <- conf.level
+  args$model <- x
+
+  if (
+    inherits(x, "betareg") &&
+      !is.null(args$component) &&
+      args$component == "mean"
+  ) {
+    args$component <- "conditional"
+  }
 
-  res <- x %>%
-    parameters::model_parameters(ci = conf.level, ...) %>%
+  res <-
+    do.call(parameters::model_parameters, args) %>%
     parameters::standardize_names(style = "broom")
 
   if (inherits(x, "multinom")) {
@@ -33,6 +46,23 @@ tidy_parameters <- function(x, conf.int = TRUE, conf.level = .95, ...) {
     }
   }
 
+  if (!is.null(args$component)) {
+    attr(res, "component") <- args$component
+  }
+
+  # for betareg, need to standardize component with tidy::broom()
+  if (inherits(x, "betareg")) {
+    if (is.null(args$component) || args$component == "conditional") {
+      res$component <- "mean"
+    }
+    if (!is.null(args$component) && args$component == "precision") {
+      res$component <- "precision"
+    }
+    if (!is.null(args$component) && args$component == "all") {
+      res$component[res$component == "conditional"] <- "mean"
+    }
+  }
+
   res
 }
 
@@ -56,13 +86,31 @@ tidy_with_broom_or_parameters <- function(x, conf.int = TRUE, conf.level = .95,
 
   if (inherits(x, "LORgee")) {
     cli::cli_alert_info("{.pkg multgee} model detected.")
-    cli::cli_alert_success("{.code tidy_multgee()} used instead.")
+    cli::cli_alert_success("{.fn tidy_multgee} used instead.")
     cli::cli_alert_info(
       "Add {.code tidy_fun = broom.helpers::tidy_multgee} to quiet these messages."
     )
     return(tidy_multgee(x, conf.int = conf.int, conf.level = conf.level, ...))
   }
 
+  if (inherits(x, "zeroinfl")) {
+    cli::cli_alert_info("{.cls zeroinfl} model detected.")
+    cli::cli_alert_success("{.fn tidy_zeroinfl} used instead.")
+    cli::cli_alert_info(
+      "Add {.code tidy_fun = broom.helpers::tidy_zeroinfl} to quiet these messages."
+    )
+    return(tidy_zeroinfl(x, conf.int = conf.int, conf.level = conf.level, ...))
+  }
+
+  if (inherits(x, "hurdle")) {
+    cli::cli_alert_info("{.cls hurdle} model detected.")
+    cli::cli_alert_success("{.fn tidy_zeroinfl} used instead.")
+    cli::cli_alert_info(
+      "Add {.code tidy_fun = broom.helpers::tidy_zeroinfl} to quiet these messages."
+    )
+    return(tidy_zeroinfl(x, conf.int = conf.int, conf.level = conf.level, ...))
+  }
+
   tidy_args <- list(...)
   tidy_args$x <- x
   tidy_args$conf.int <- conf.int
@@ -78,6 +126,47 @@ tidy_with_broom_or_parameters <- function(x, conf.int = TRUE, conf.level = .95,
     }
   }
 
+  # for betareg, if exponentiate = TRUE, forcing tidy_parameters,
+  # by adding `component = "all" to the arguments`
+  if (inherits(x, "betareg")) {
+    if (isFALSE(tidy_args$exponentiate)) {
+      tidy_args$exponentiate <- NULL
+    } else if (isTRUE(tidy_args$exponentiate)) {
+      component <- tidy_args$component
+      cli::cli_alert_info(
+        "{.code exponentiate = TRUE} not valid for {.cl betareg} with {.fn broom::tidy()}."
+      )
+      if (is.null(component)) {
+        cli::cli_alert_success("{.code tidy_parameters(component = \"all\")} used instead.")
+        cli::cli_alert_info(
+          "Add {.code tidy_fun = broom.helpers::tidy_parameters} to quiet these messages."
+        )
+        return(
+          tidy_parameters(
+            x,
+            conf.int = conf.int,
+            conf.level = conf.level,
+            component = "all",
+            ...
+          )
+        )
+      } else {
+        cli::cli_alert_success("{.code tidy_parameters()} used instead.")
+        cli::cli_alert_info(
+          "Add {.code tidy_fun = broom.helpers::tidy_parameters} to quiet these messages."
+        )
+        return(
+          tidy_parameters(
+            x,
+            conf.int = conf.int,
+            conf.level = conf.level,
+            ...
+          )
+        )
+      }
+    }
+  }
+
   res <- tryCatch(
     do.call(tidy_broom, tidy_args),
     error = function(e) {
@@ -204,3 +293,62 @@ tidy_multgee <- function(x, conf.int = TRUE, conf.level = .95, ...) {
     return(res)
   }
 }
+
+#' Tidy a `zeroinfl` or a `hurdle` model
+#'
+#' `r lifecycle::badge("experimental")`
+#' A tidier for models generated with `pscl::zeroinfl()` or `pscl::hurdle()`.
+#' Term names will be updated to be consistent with generic models. The original
+#' term names are preserved in an `"original_term"` column.
+#' @param x a `pscl::zeroinfl()` or a `pscl::hurdle()` model
+#' @param conf.int logical indicating whether or not to include a confidence
+#' interval in the tidied output
+#' @param conf.level the confidence level to use for the confidence interval
+#' @param component `NULL` or one of `"all"`, `"conditional"`, `"zi"`, or
+#' `"zero_inflated"`
+#' @param ... additional parameters passed to `parameters::model_parameters()`
+#' @export
+#' @family custom_tieders
+#' @examplesIf interactive()
+#' if (.assert_package("pscl", boolean = TRUE)) {
+#'   library(pscl)
+#'   mod <- zeroinfl(
+#'     art ~ fem + mar + phd,
+#'     data = pscl::bioChemists
+#'   )
+#'
+#'   mod %>% tidy_zeroinfl(exponentiate = TRUE)
+#' }
+tidy_zeroinfl <- function(
+    x,
+    conf.int = TRUE,
+    conf.level = .95,
+    component = NULL,
+    ...) {
+  if (!inherits(x, "zeroinfl") && !inherits(x, "hurdle")) {
+    cli::cli_abort("{.arg x} should be of class {.cls zeroinfl} or {.cls hurdle}")
+  } # nolint
+
+  res <- tidy_parameters(
+    x,
+    conf.int = conf.int,
+    conf.level = conf.level,
+    component = component,
+    ...
+  )
+  res$original_term <- res$term
+  starts_zero <- stringr::str_starts(res$term, "zero_")
+  res$term[starts_zero] <- stringr::str_sub(res$term[starts_zero], 6)
+  starts_count <- stringr::str_starts(res$term, "count_")
+  res$term[starts_count] <- stringr::str_sub(res$term[starts_count], 7)
+
+  if (!is.null(component) && component %in% c("conditional", "zero_inflated")) {
+    res$component <- component
+  }
+  if (!is.null(component) && component == "zi") {
+    res$component <- "zero_inflated"
+  }
+
+  attr(res, "component") <- component
+  res
+}

R/model_get_contrasts.R

@@ -60,3 +60,27 @@ model_get_contrasts_3 <- function(model) {
 model_get_contrasts.model_fit <- function(model) {
   model_get_contrasts(model$fit)
 }
+
+#' @export
+#' @rdname model_get_contrasts
+model_get_contrasts.zeroinfl <- function(model) {
+  mc <- model_get_contrasts_1(model)
+  res <- mc$count
+  # merging/combining the two lists
+  for (v in names(mc$zero)) res[[v]] <- mc$zero[[v]]
+  res
+}
+
+#' @export
+#' @rdname model_get_contrasts
+model_get_contrasts.hurdle <- model_get_contrasts.zeroinfl
+
+#' @export
+#' @rdname model_get_contrasts
+model_get_contrasts.betareg <- function(model) {
+  mc <- model_get_contrasts_1(model)
+  res <- mc$mean
+  # merging/combining the two lists
+  for (v in names(mc$precision)) res[[v]] <- mc$precision[[v]]
+  res
+}

R/model_get_model_matrix.R

@@ -130,3 +130,12 @@ model_get_model_matrix.mmrm <- function(model, ...) {
     data = stats::model.frame(model)
   )
 }
+
+#' @export
+#' @rdname model_get_model_matrix
+model_get_model_matrix.betareg <- function(model, ...) {
+  stats::model.matrix.default(
+    model %>% model_get_terms(),
+    data = model %>% model_get_model_frame()
+  )
+}