Prepare Release 1.0.0: Check {insight} API / documentation on API

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.20.5.1
+Version: 0.99.0
 Authors@R:
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -134,7 +134,6 @@ Suggests:
     grDevices,
     gt,
     httptest2,
-    httr,
     httr2,
     interp,
     ivreg,

NAMESPACE

@@ -329,6 +329,7 @@ S3method(find_response,mediate)
 S3method(find_response,mjoint)
 S3method(find_response,model_fit)
 S3method(find_response,selection)
+S3method(find_statistic,default)
 S3method(find_terms,afex_aov)
 S3method(find_terms,aovlist)
 S3method(find_terms,bfsl)
@@ -550,6 +551,12 @@ S3method(get_df,svy2lme)
 S3method(get_df,systemfit)
 S3method(get_df,truncreg)
 S3method(get_df,vgam)
+S3method(get_dispersion,brmsfit)
+S3method(get_dispersion,default)
+S3method(get_dispersion,glm)
+S3method(get_dispersion,glmerMod)
+S3method(get_dispersion,glmmTMB)
+S3method(get_dispersion,model_fit)
 S3method(get_family,default)
 S3method(get_family,list)
 S3method(get_family,model_fit)
@@ -1699,6 +1706,7 @@ export(get_data)
 export(get_datagrid)
 export(get_deviance)
 export(get_df)
+export(get_dispersion)
 export(get_family)
 export(get_intercept)
 export(get_loglikelihood)

NEWS.md

@@ -1,10 +1,21 @@
-# insight 0.20.x
+# insight 1.0.0
+
+## Breaking changes
+
+* All deprecated arguments have been removed.
 
 ## General
 
+* `get_dispersion()` is now an exported function.
+
 * Updates `get_varcov()` (and related documentation) to support new covariance
   matrix estimation methods from the **sandwich** package.
 
+## Bug fix
+
+* `clean_parameters()` now uses the correct labels for the random effects
+  variances (`"SD/Cor"` has changed to `"Var/Cov"`).
+
 # insight 0.20.5
 
 ## General

R/clean_parameters.R

@@ -528,7 +528,7 @@
   out$Cleaned_Parameter <- gsub(pattern = "^b_(?!zi_)(.*)\\.(\\d)\\.$", "\\1[\\2]", out$Cleaned_Parameter, perl = TRUE)
   out$Cleaned_Parameter <- gsub(pattern = "^b_zi_(.*)\\.(\\d)\\.$", "\\1[\\2]", out$Cleaned_Parameter, perl = TRUE)
   out$Cleaned_Parameter <- gsub(pattern = "^(b_|bs_|bsp_|bcs_)(?!zi_)(.*)", "\\2", out$Cleaned_Parameter, perl = TRUE)
   out$Cleaned_Parameter <- gsub(pattern = "^(b_zi_|bs_zi_|bsp_zi_|bcs_zi_)(.*)", "\\2", out$Cleaned_Parameter, perl = TRUE)
 
   # correlation and sd
 
@@ -539,7 +539,7 @@
     # replace "__" by "~"
     cor_only <- startsWith(out$Parameter[cor_sd], "cor_")
     if (any(cor_only)) {
       out$Cleaned_Parameter[which(cor_sd)[cor_only]] <- sub("__", " ~ ", out$Cleaned_Parameter[which(cor_sd)[cor_only]], fixed = TRUE)
     }
   }
 
@@ -585,7 +585,7 @@
 
   simplex <- startsWith(out$Cleaned_Parameter, "simo_")
   if (length(simplex)) {
     out$Cleaned_Parameter[simplex] <- gsub("^(simo_|simo_mo)(.*)\\[(\\d)\\]$", "\\2[\\3]", out$Cleaned_Parameter[simplex])
     out$Component[simplex] <- "simplex"
   }
 
@@ -652,7 +652,7 @@
     if (any(rand_cor)) {
       out$Cleaned_Parameter[which(cor_sd)[rand_cor]] <- paste0(parm1[rand_cor], " ~ ", parm2[rand_cor])
     }
-    out$Group[cor_sd] <- paste("SD/Cor:", gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\1", out$Parameter[cor_sd], perl = TRUE))
+    out$Group[cor_sd] <- paste("Var/Cov:", gsub("^Sigma\\[(.*):(.*),(.*)\\]", "\\1", out$Parameter[cor_sd], perl = TRUE))
   }
 
 
@@ -669,9 +669,9 @@
       out$Group[rand_effects] <- r_grps
       out$Level[rand_effects] <- r_levels
       # fix labelling of SD and correlation component
-      sd_cor <- grepl("SD/Cor:", out$Group, fixed = TRUE)
+      sd_cor <- grepl("Var/Cov:", out$Group, fixed = TRUE)
       if (any(sd_cor)) {
-        out$Group[sd_cor] <- gsub("SD/Cor: (.*)", "\\1", out$Group[sd_cor])
+        out$Group[sd_cor] <- gsub("Var/Cov: (.*)", "\\1", out$Group[sd_cor])
       }
     } else {
       re_grp_level <- gsub("b\\[(.*) (.*):(.*)\\]", "\\2", out$Cleaned_Parameter[rand_effects])

R/download_model.R

@@ -32,54 +32,6 @@ download_model <- function(name,
                            url = "https://raw.github.com/easystats/circus/master/data/",
                            extension = ".rda",
                            verbose = TRUE) {
-  if (check_if_installed("httr2", quietly = TRUE)) {
-    .download_data_httr2(name, url, extension, verbose)
-  } else {
-    .download_data_httr(name, url, extension, verbose)
-  }
-}
-
-
-# Download rda files from github, using httr
-.download_data_httr <- function(name, url, extension, verbose) {
-  check_if_installed("httr", "to download models from the circus-repo")
-
-  url <- paste0(url, name, extension)
-
-  temp_file <- tempfile()
-  on.exit(unlink(temp_file))
-
-  result <- tryCatch(
-    {
-      request <- httr::GET(url)
-      httr::stop_for_status(request)
-    },
-    error = function(e) {
-      if (verbose) {
-        format_alert(
-          "Could not download model. Request failed with following error:",
-          e$message
-        )
-      }
-      NULL
-    }
-  )
-  if (is.null(result)) {
-    return(NULL)
-  }
-
-  writeBin(httr::content(request, type = "raw"), temp_file)
-
-  x <- load(temp_file)
-  model <- get(x)
-  rm(x)
-
-  model
-}
-
-
-# Download rda files from github, using httr2
-.download_data_httr2 <- function(name, url, extension = ".rda", verbose = TRUE) {
   check_if_installed("httr2", "to download models from the circus-repo")
 
   url <- paste0(url, name, extension)

R/find_statistic.R

@@ -19,6 +19,11 @@
 #' find_statistic(m)
 #' @export
 find_statistic <- function(x, ...) {
+  UseMethod("find_statistic")
+}
+
+#' @export
+find_statistic.default <- function(x, ...) {
   # model object check --------------------------------------------------------
 
   # check if the object is a model object; if not, quit early

R/get_auxiliary.R

@@ -20,10 +20,13 @@
 #'
 #' @details Currently, only sigma and the dispersion parameter are returned, and
 #' only for a limited set of models.
-#' \subsection{Sigma Parameter}{
-#' See [get_sigma()].
-#' }
-#' \subsection{Dispersion Parameter}{
+#'
+#' @section Sigma Parameter:
+#'
+#' See [`get_sigma()`].
+#'
+#' @section  Dispersion Parameter:
+#'
 #' There are many different definitions of "dispersion", depending on the context.
 #' `get_auxiliary()` returns the dispersion parameters that usually can
 #' be considered as variance-to-mean ratio for generalized (linear) mixed
@@ -36,12 +39,12 @@
 #' and is the ratio of the sum of the squared Pearson-residuals and the residual
 #' degrees of freedom. For models of class `glmmTMB`, dispersion is
 #' \ifelse{html}{\out{&sigma;<sup>2</sup>}}{\eqn{\sigma^2}}.
-#' }
-#' \subsection{**brms** models}{
+#'
+#' @section  brms-models:
+#'
 #' For models of class `brmsfit`, there are different options for the
 #' `type` argument. See a list of supported auxiliary parameters here:
-#' [find_parameters.BGGM()].
-#' }
+#' [`find_parameters.BGGM()`].
 #'
 #' @examples
 #' # from ?glm
@@ -74,21 +77,26 @@ get_auxiliary <- function(x,
 
 
 
-
-
 # dispersion parameter -----------------------
 
-#' @keywords internal
+#' @rdname get_auxiliary
+#' @export
 get_dispersion <- function(x, ...) {
   UseMethod("get_dispersion")
 }
 
-#' @keywords internal
+#' @rdname get_auxiliary
+#' @export
+get_dispersion.default <- function(x, ...) {
+  format_error(sprintf("`get_dispersion()` does not yet support models of class \"%s\".", class(x)[1])) # nolint
+}
+
+#' @export
 get_dispersion.model_fit <- function(x, ...) {
   get_dispersion(x$fit, ...)
 }
 
-#' @keywords internal
+#' @export
 get_dispersion.glm <- function(x, verbose = TRUE, ...) {
   info <- model_info(x, verbose = verbose)
   disp <- NULL
@@ -103,7 +111,7 @@ get_dispersion.glm <- function(x, verbose = TRUE, ...) {
   disp
 }
 
-#' @keywords internal
+#' @export
 get_dispersion.glmerMod <- function(x, verbose = TRUE, ...) {
   info <- model_info(x, verbose = verbose)
   disp <- NULL
@@ -122,7 +130,7 @@ get_dispersion.glmerMod <- function(x, verbose = TRUE, ...) {
   disp
 }
 
-#' @keywords internal
+#' @export
 get_dispersion.glmmTMB <- function(x, verbose = TRUE, ...) {
   info <- model_info(x, verbose = verbose)
   disp <- NULL
@@ -135,7 +143,7 @@ get_dispersion.glmmTMB <- function(x, verbose = TRUE, ...) {
   disp
 }
 
-#' @keywords internal
+#' @export
 get_dispersion.brmsfit <- get_dispersion.glmmTMB
 
 

R/get_varcov.R

@@ -1172,6 +1172,9 @@ get_varcov.LORgee <- get_varcov.gee
       sprintf("The `vcov` argument of the `insight::get_varcov()` function is not yet supported for models of class `%s`.", paste(class(x), collapse = "/")) # nolint
     )
   }
+  if ("robust" %in% names(dots) && !is.null(dots[["robust"]])) {
+    format_warning("The `robust` argument is no longer supported. Please use the `vcov` and `vcov_args` instead.") # nolint
+  }
 }
 
 
@@ -1182,16 +1185,5 @@ get_varcov.LORgee <- get_varcov.gee
   if (is.null(vcov) && "vcov_estimation" %in% names(dots)) {
     vcov <- dots[["vcov_estimation"]]
   }
-
-  if ("robust" %in% names(dots)) {
-    # default robust covariance
-    if (is.null(vcov)) {
-      vcov <- "HC3"
-    }
-    if (isTRUE(verbose)) {
-      format_warning("The `robust` argument is deprecated. Please use `vcov` instead.")
-    }
-  }
-
   vcov
 }

R/get_weights.R

@@ -9,7 +9,6 @@
 #'   if no weights were specified in the model (as if the weights were all set
 #'   to 1).
 #' @param ... Currently not used.
-#' @param na_rm Deprecated, use `remove_na` instead.
 #'
 #' @return The weighting variable, or `NULL` if no weights were specified.
 #' If the weighting variable should also be returned (instead of `NULL`)
@@ -42,11 +41,7 @@ get_weights <- function(x, ...) {
 
 #' @rdname get_weights
 #' @export
-get_weights.default <- function(x, remove_na = FALSE, null_as_ones = FALSE, na_rm = remove_na, ...) {
-  ## TODO: remove deprecated later
-  if (!missing(na_rm)) {
-    remove_na <- na_rm
-  }
+get_weights.default <- function(x, remove_na = FALSE, null_as_ones = FALSE, ...) {
   weight_vars <- find_weights(x)
   w <- tryCatch(
     stats::weights(x, ...),
@@ -100,12 +95,7 @@ get_weights.default <- function(x, remove_na = FALSE, null_as_ones = FALSE, na_r
 
 
 #' @export
-get_weights.brmsfit <- function(x, remove_na = FALSE, null_as_ones = FALSE, na_rm = remove_na, ...) {
-  ## TODO: remove deprecated later
-  if (!missing(na_rm)) {
-    remove_na <- na_rm
-  }
-
+get_weights.brmsfit <- function(x, remove_na = FALSE, null_as_ones = FALSE, ...) {
   w <- unique(find_weights(x))
 
   if (!is.null(w)) {
@@ -139,12 +129,7 @@ get_weights.btergm <- function(x, null_as_ones = FALSE, ...) {
 
 
 #' @export
-get_weights.list <- function(x, remove_na = FALSE, null_as_ones = FALSE, na_rm = remove_na, ...) {
-  ## TODO: remove deprecated later
-  if (!missing(na_rm)) {
-    remove_na <- na_rm
-  }
-
+get_weights.list <- function(x, remove_na = FALSE, null_as_ones = FALSE, ...) {
   # For GAMMs
   if ("gam" %in% names(x)) {
     get_weights(x$gam, remove_na = remove_na, null_as_ones = null_as_ones, ...)

R/utilities.R

@@ -16,7 +16,6 @@
 #' @param character_only Logical, if `TRUE` and `x` is a data frame or list,
 #' only processes character vectors.
 #' @param ... Currently not used.
-#' @param na.rm Deprecated. Use `remove_na` instead.
 #'
 #' @return
 #' - `n_unique()`: For a vector, `n_unique` always returns an integer value,
@@ -89,36 +88,21 @@ n_unique <- function(x, ...) {
 
 #' @rdname trim_ws
 #' @export
-n_unique.default <- function(x, remove_na = TRUE, na.rm = TRUE, ...) {
+n_unique.default <- function(x, remove_na = TRUE, ...) {
   if (is.null(x)) {
     return(0)
   }
-  ## TODO:: remove deprecation warning later
-  if (!missing(na.rm)) {
-    format_warning("The `na.rm` argument is deprecated. Use `remove_na` instead.")
-    remove_na <- na.rm
-  }
   if (isTRUE(remove_na)) x <- x[!is.na(x)]
   length(unique(x))
 }
 
 #' @export
-n_unique.data.frame <- function(x, remove_na = TRUE, na.rm = TRUE, ...) {
-  ## TODO:: remove deprecation warning later
-  if (!missing(na.rm)) {
-    format_warning("The `na.rm` argument is deprecated. Use `remove_na` instead.")
-    remove_na <- na.rm
-  }
+n_unique.data.frame <- function(x, remove_na = TRUE, ...) {
   vapply(x, n_unique, remove_na = remove_na, FUN.VALUE = numeric(1L))
 }
 
 #' @export
-n_unique.list <- function(x, remove_na = TRUE, na.rm = TRUE, ...) {
-  ## TODO:: remove deprecation warning later
-  if (!missing(na.rm)) {
-    format_warning("The `na.rm` argument is deprecated. Use `remove_na` instead.")
-    remove_na <- na.rm
-  }
+n_unique.list <- function(x, remove_na = TRUE, ...) {
   lapply(x, n_unique, remove_na = remove_na)
 }
 
@@ -132,7 +116,7 @@ safe_deparse <- function(x, ...) {
   if (is.null(x)) {
     return(NULL)
   }
-  paste0(sapply(deparse(x, width.cutoff = 500), trim_ws, simplify = TRUE), collapse = " ")
+  paste(sapply(deparse(x, width.cutoff = 500), trim_ws, simplify = TRUE), collapse = " ")
 }
 
 
@@ -155,12 +139,7 @@ safe_deparse_symbol <- function(x) {
 
 #' @rdname trim_ws
 #' @export
-has_single_value <- function(x, remove_na = FALSE, na.rm = TRUE, ...) {
-  ## TODO:: remove deprecation warning later
-  if (!missing(na.rm)) {
-    format_warning("The `na.rm` argument is deprecated. Use `remove_na` instead.")
-    remove_na <- na.rm
-  }
+has_single_value <- function(x, remove_na = FALSE, ...) {
   if (remove_na) x <- x[!is.na(x)]
   !is.null(x) && length(x) > 0L && isTRUE(all(x == x[1]))
 }