Added family(<distribution>) methods

Ref: tidyverts/fable#353

NAMESPACE

@@ -131,6 +131,9 @@ S3method(dim,dist_default)
 S3method(dim,dist_multinomial)
 S3method(dim,dist_mvnorm)
 S3method(dimnames,distribution)
+S3method(family,dist_default)
+S3method(family,dist_wrap)
+S3method(family,distribution)
 S3method(format,dist_bernoulli)
 S3method(format,dist_beta)
 S3method(format,dist_binomial)
@@ -522,6 +525,7 @@ importFrom(grDevices,col2rgb)
 importFrom(grDevices,rgb)
 importFrom(lifecycle,deprecate_soft)
 importFrom(stats,density)
+importFrom(stats,family)
 importFrom(stats,median)
 importFrom(stats,quantile)
 importFrom(utils,.DollarNames)

NEWS.md

@@ -9,6 +9,7 @@
 ### Generics
 
 * Added `parameters()` generic for obtaining the distribution's parameters.
+* Added `family(<distribution>)` for getting the distribution's family name.
 * Added `covariance()` to return the covariance of a distribution.
 * Added `support()` to identify the distribution's region of support (#8).
 

R/default.R

@@ -62,6 +62,11 @@ parameters.dist_default <- function(x, ...) {
   })
 }
 
+#' @export
+family.dist_default <- function(x, ...) {
+  substring(class(x)[1], first = 6)
+}
+
 #' @export
 support.dist_default <- function(x, ...) {
   new_support_region(

R/dist_wrap.R

@@ -116,5 +116,10 @@ generate.dist_wrap <- function(x, times, ...){
 #' @export
 parameters.dist_wrap <- function(x, ...) {
   # All parameters except distribution environment
-  x[-2]
+  x[-2L]
+}
+
+#' @export
+family.dist_wrap <- function(x, ...) {
+  x[[1L]]
 }

R/distribution.R

@@ -222,6 +222,29 @@ parameters.distribution <- function(x, ...) {
   x <- lapply(x, function(z) data_frame(!!!z, .name_repair = "minimal"))
   vec_rbind(!!!x)
 }
+
+#' Extract the name of the distribution family
+#'
+#' \lifecycle{experimental}
+#'
+#' @param x The distribution(s).
+#' @param ... Additional arguments used by methods.
+#'
+#' @examples
+#' dist <- c(
+#'   dist_normal(1:2),
+#'   dist_poisson(3),
+#'   dist_multinomial(size = c(4, 3),
+#'   prob = list(c(0.3, 0.5, 0.2), c(0.1, 0.5, 0.4)))
+#'   )
+#' family(dist)
+#'
+#' @importFrom stats family
+#' @export
+family.distribution <- function(x, ...) {
+  vapply(vec_data(x), family, character(1L))
+}
+
 #' Region of support of a distribution
 #'
 #' \lifecycle{experimental}

_pkgdown.yml

@@ -21,6 +21,7 @@ reference:
     - hilo.distribution
     - hdr.distribution
     - support.distribution
+    - family.distribution
     - parameters.distribution
     - mean.distribution
     - median.distribution