Merge branch 'attributes-decorator'

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: univariateML
 Type: Package
 Title: Maximum Likelihood Estimation for Univariate Densities
-Version: 1.2.0
+Version: 1.5.0
 Authors@R: c(
     person("Jonas", "Moss", , "jonas.gjertsen@gmail.com", role = c("aut", "cre"), 
       comment = c(ORCID = "0000-0002-6876-6964")),
@@ -21,7 +21,12 @@ Imports: assertthat,
     logitnorm,
     actuar,
     nakagami,
-    fGarch
+    fGarch,
+    rlang,
+    intervals,
+    Rfast,
+    pracma,
+    sads
 Suggests: 
     testthat,
     knitr,

NAMESPACE

@@ -12,23 +12,27 @@ export(bootstrapml)
 export(dml)
 export(mlbeta)
 export(mlbetapr)
+export(mlbinom)
 export(mlcauchy)
 export(mlexp)
 export(mlgamma)
 export(mlged)
+export(mlgeom)
 export(mlgumbel)
 export(mlinvgamma)
 export(mlinvgauss)
 export(mlinvweibull)
 export(mlkumar)
 export(mllaplace)
 export(mllgamma)
+export(mllgser)
 export(mlllogis)
 export(mllnorm)
 export(mllogis)
 export(mllogitnorm)
 export(mllomax)
 export(mlnaka)
+export(mlnbinom)
 export(mlnorm)
 export(mlpareto)
 export(mlpois)
@@ -40,6 +44,8 @@ export(mlsstd)
 export(mlstd)
 export(mlunif)
 export(mlweibull)
+export(mlzip)
+export(mlzipf)
 export(model_select)
 export(pml)
 export(ppmlline)

R/aaa.R

@@ -0,0 +1 @@
+metadata <- list()

R/bootstrap.R

@@ -56,7 +56,7 @@
 #' ## parametric bootstrap confidence interval for the mean with confidence
 #' ## limits c(0.05, 0.95)
 #'
-#' bootstrapml(object, map = function(x) x[1] / x[2], probs = c(0.05, 0.95))
+#' bootstrapml(object, map = \(x) x[1] / x[2], probs = c(0.05, 0.95))
 #'
 #' #       5%      95%
 #' # 17.33962 18.31253
@@ -66,8 +66,8 @@
 #' hist(bootstrapml(object, reducer = identity))
 #' }
 #'
-bootstrapml <- function(object, reps = 1000, map = identity,
-                        reducer = stats::quantile, ...) {
+bootstrapml <- \(object, reps = 1000, map = identity,
+  reducer = stats::quantile, ...) {
   r_fun <- univariateML_to_function(object, type = "r")
   ml_fun <- univariateML_to_function(object, type = "ml")
   bootstraps <- replicate(n = reps, expr = ml_fun(r_fun(attr(object, "n"))))
@@ -87,8 +87,8 @@ bootstrapml <- function(object, reps = 1000, map = identity,
   }
 
   if (is.null(dim(mapped))) {
-    do.call(function(...) reducer(mapped, ...), arguments)
+    do.call(\(...) reducer(mapped, ...), arguments)
   } else {
-    do.call(function(...) t(apply(mapped, 1, reducer, ...)), arguments)
+    do.call(\(...) t(apply(mapped, 1, reducer, ...)), arguments)
   }
 }

R/data-corbet.R

@@ -0,0 +1,12 @@
+#' Frequencies of butterflies collected in Malaya
+#'
+#' Species abundance data from 1943; a classical application of the logarithmic
+#'   series distribution.
+#'
+#' @format A vector of size 501 containing integer observations between 1 and 24.
+#'
+#' @references
+#'  Fisher, R. A., Corbet, A. S., & Williams, C. B. (1943). The relation between the number of species and the number of individuals in a random sample of an animal population. The Journal of Animal Ecology, 12(1), 42. https://doi.org/10.2307/1411
+#' @examples
+#' corbet
+"corbet"

R/densities.R

@@ -1,14 +0,0 @@
-densities <- list.files("R")
-densities <- densities[sapply(densities, \(x) substr(x, 1, 2) == "ml")]
-densities <- densities[!grepl("select", densities)]
-densities <- unname(unlist(sapply(densities, \(x) strsplit(x, ".R"))))
-
-
-#' Implemented models
-#'
-#' Vector of all supported models in `univariateML`.
-#'
-#' The currently supported models are `r paste0("[ml",paste0(univariateML_models, "]"))`
-#'
-#' @export
-univariateML_models <- substring(densities, first = 3)

R/functions.R

@@ -35,13 +35,13 @@
 #' obj <- mlbetapr(airquality$Wind)
 #'
 #' # Plot the logarithm of the beta prime distribution.
-#' plot(function(x) dml(x, obj, log = TRUE),
+#' plot(\(x) dml(x, obj, log = TRUE),
 #'   from = 0, to = 20,
 #'   main = "Logarithm of Density", ylab = NA, lwd = 2
 #' )
 #' @name MaximumLikelihoodDistribution
 #' @export
-dml <- function(x, obj, log = FALSE) {
+dml <- \(x, obj, log = FALSE) {
   fun <- univariateML_to_function(obj, type = "d")
   if (!("log" %in% names(formals(fun)))) {
     log(fun(x = x))
@@ -52,7 +52,7 @@ dml <- function(x, obj, log = FALSE) {
 
 #' @rdname MaximumLikelihoodDistribution
 #' @export
-pml <- function(q = q, obj, lower.tail = TRUE, log.p = FALSE) {
+pml <- \(q = q, obj, lower.tail = TRUE, log.p = FALSE) {
   fun <- univariateML_to_function(obj, type = "p")
   if (!all(c("log.p", "lower.tail") %in% names(formals(fun)))) {
     p <- fun(q = q)
@@ -66,7 +66,7 @@ pml <- function(q = q, obj, lower.tail = TRUE, log.p = FALSE) {
 
 #' @rdname MaximumLikelihoodDistribution
 #' @export
-qml <- function(p = p, obj, lower.tail = TRUE, log.p = FALSE) {
+qml <- \(p = p, obj, lower.tail = TRUE, log.p = FALSE) {
   fun <- univariateML_to_function(obj, type = "q")
   if (!all(c("log.p", "lower.tail") %in% names(formals(fun)))) {
     if (!lower.tail) p <- 1 - p
@@ -79,6 +79,6 @@ qml <- function(p = p, obj, lower.tail = TRUE, log.p = FALSE) {
 
 #' @rdname MaximumLikelihoodDistribution
 #' @export
-rml <- function(n = n, obj) {
+rml <- \(n = n, obj) {
   univariateML_to_function(obj, type = "r")(n = n)
 }

R/generics.R

@@ -5,34 +5,34 @@
 #' @param points Boolean; should points be plotted by default?
 #' @keywords internal
 
-plot_wrangler <- function(x, range, points = FALSE, kind, ...) {
-  continuous <- if(is.null(attr(x,"continuous"))) TRUE else FALSE
+plot_wrangler <- \(x, range, points = FALSE, kind, ...) {
+  continuous <- if (is.null(attr(x, "continuous"))) TRUE else attr(x, "continuous")
   support <- attr(x, "support")
   if (is.null(range)) {
-    if (abs(support[1]) + abs(support[2]) < Inf) {
-      limits <- support
-    } else if (abs(support[1]) == 0 & abs(support[2]) == Inf) {
+    if (abs(support[[1]]) + abs(support[[2]]) < Inf) {
+      limits <- as.numeric(support)
+    } else if (abs(support[[1]]) == 0 && abs(support[[2]]) == Inf) {
       limits <- c(0, qml(0.995, x))
     } else {
       limits <- qml(c(0.005, 0.995), x)
     }
 
     limits_untransformed <- limits
-    if(kind == "q") limits <- pml(limits, x)
+    if (kind == "q") limits <- pml(limits, x)
 
     range <- if (continuous) {
       seq(limits[1], limits[2], length.out = 1000)
     } else {
-      if(kind == "q") {
+      if (kind == "q") {
         pml(seq(limits_untransformed[1], limits_untransformed[2]), x)
       } else {
         seq(limits[1], limits[2])
       }
     }
   }
 
-  ylab <- list(d="Density",p="Cumulative probability",q="Quantile")
-  xlab <- list(d="x",p="Quantile",q="Cumulative probability")
+  ylab <- list(d = "Density", p = "Cumulative probability", q = "Quantile")
+  xlab <- list(d = "x", p = "Quantile", q = "Cumulative probability")
   defaults <- list(
     type = if (points) "p" else "l",
     main = paste0(attr(x, "model"), " model"),
@@ -41,9 +41,9 @@ plot_wrangler <- function(x, range, points = FALSE, kind, ...) {
     lwd = 1
   )
 
-  if(!continuous) {
-    defaults$pch = 20
-    defaults$type = if (points) "p" else "b"
+  if (!continuous) {
+    defaults$pch <- 20
+    defaults$type <- if (points) "p" else "b"
   }
 
   args <- listmerge(
@@ -52,7 +52,7 @@ plot_wrangler <- function(x, range, points = FALSE, kind, ...) {
   )
 
   args$x <- range
-  args$y <- if(kind == "d") {
+  args$y <- if (kind == "d") {
     dml(args$x, x)
   } else if (kind == "p") {
     pml(args$x, x)
@@ -79,7 +79,7 @@ plot_wrangler <- function(x, range, points = FALSE, kind, ...) {
 #' rug(datasets::precip)
 #' @export
 #'
-plot.univariateML <- function(x, range = NULL, kind = c("d", "p", "q"), ...) {
+plot.univariateML <- \(x, range = NULL, kind = c("d", "p", "q"), ...) {
   kind <- match.arg(kind)
   args <- plot_wrangler(x, range, points = FALSE, kind = kind, ...)
   do.call(graphics::plot, args)
@@ -88,7 +88,7 @@ plot.univariateML <- function(x, range = NULL, kind = c("d", "p", "q"), ...) {
 
 #' @export
 #' @rdname plot.univariateML
-lines.univariateML <- function(x, range = NULL, kind = c("d", "p", "q"), ...) {
+lines.univariateML <- \(x, range = NULL, kind = c("d", "p", "q"), ...) {
   kind <- match.arg(kind)
   args <- plot_wrangler(x, range, points = FALSE, kind = kind, ...)
   do.call(graphics::lines, args)
@@ -97,15 +97,15 @@ lines.univariateML <- function(x, range = NULL, kind = c("d", "p", "q"), ...) {
 
 #' @export
 #' @rdname plot.univariateML
-points.univariateML <- function(x, range = NULL, kind = c("d", "p", "q"), ...) {
+points.univariateML <- \(x, range = NULL, kind = c("d", "p", "q"), ...) {
   kind <- match.arg(kind)
-  args <- plot_wrangler(x, range, points = TRUE, kind = kind,...)
+  args <- plot_wrangler(x, range, points = TRUE, kind = kind, ...)
   do.call(graphics::points, args)
   invisible(x)
 }
 
 #' @export
-logLik.univariateML <- function(object, ...) {
+logLik.univariateML <- \(object, ...) {
   val <- attr(object, "logLik")
   attr(val, "nobs") <- attr(object, "n")
   attr(val, "df") <- length(object)
@@ -114,12 +114,12 @@ logLik.univariateML <- function(object, ...) {
 }
 
 #' @export
-coef.univariateML <- function(object, ...) {
+coef.univariateML <- \(object, ...) {
   stats::setNames(as.numeric(object), names(object))
 }
 
 #' @export
-summary.univariateML <- function(object, ...) {
+summary.univariateML <- \(object, ...) {
   data.name <- deparse(as.list(attr(object, "call"))$x)
   digits <- list(...)$digits
   support <- attr(object, "support")
@@ -129,7 +129,7 @@ summary.univariateML <- function(object, ...) {
   )
   print.default(format(object, digits = digits), print.gap = 2L, quote = FALSE)
   cat("\nData:            ", data.name, " (", attr(object, "n"), " obs.)\n",
-    "Support:         (", support[1], ", ", support[2], ")\n",
+    "Support:         (", support[[1]], ", ", support[[2]], ")\n",
     "Density:         ", attr(object, "density"), "\n",
     "Log-likelihood:  ", attr(object, "logLik"), "\n",
     sep = ""
@@ -138,7 +138,7 @@ summary.univariateML <- function(object, ...) {
 }
 
 #' @export
-print.univariateML <- function(x, ...) {
+print.univariateML <- \(x, ...) {
   digits <- list(...)$digits
   if (is.null(digits)) digits <- 4
   cat("Maximum likelihood estimates for the", attr(x, "model"), "model \n")
@@ -178,11 +178,11 @@ print.univariateML <- function(x, ...) {
 #' confint(object) # 95% confidence interval for mean and shape
 #' confint(object, "mean") # 95% confidence interval for the mean parameter
 #' # confint(object, "variance") # Fails since 'variance isn't a main parameter.
-confint.univariateML <- function(object,
-                                 parm = NULL,
-                                 level = 0.95,
-                                 Nreps = 1000,
-                                 ...) {
+confint.univariateML <- \(object,
+  parm = NULL,
+  level = 0.95,
+  Nreps = 1000,
+  ...) {
   if (is.null(parm)) parm <- names(object)
 
   assertthat::assert_that(all(parm %in% names(object)),
@@ -192,7 +192,7 @@ confint.univariateML <- function(object,
 
   indices <- which(names(object) %in% parm)
 
-  map <- function(x) x[indices]
+  map <- \(x) x[indices]
 
   probs <- c((1 - level) / 2, 1 - (1 - level) / 2)