code clean (#809)

* code clean * docs * docs * rd * fixes * fix * docs, style * more rd * fix * docs * lintr * wordlist * more `examplesIf` * Fix some `keyword_quote_linter()` lints * code style * rd * use md * docs * rd * fix example * wordlist * styler beats lintr * lintr * lintr * Fix moer `keyword_quote_linter()` lints * fix syntax error * more lint fixes * fix rd issue * fix * add test * test * version bump * fix test * lintr * fix * lintr * ** to {} * fix strict --------- Co-authored-by: Indrajeet Patil <[email protected]>
easystats · Sep 23, 2023 · 38c809e · 38c809e
1 parent 41a48f0
commit 38c809e
Show file tree

Hide file tree

Showing 122 changed files with 1,317 additions and 1,371 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: insight
 Title: Easy Access to Model Information for Various Model Objects
-Version: 0.19.5.2
+Version: 0.19.5.3
 Authors@R: 
     c(person(given = "Daniel",
              family = "Lüdecke",
@@ -197,7 +197,7 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 Language: en-US
-RoxygenNote: 7.2.3
+RoxygenNote: 7.2.3.9000
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: true

diff --git a/R/all_equal_models.R b/R/all_equal_models.R
@@ -10,21 +10,19 @@
 #' @return A logical, `TRUE` if `x` are all supported model objects
 #'   of same class.
 #'
-#' @examples
-#' if (require("lme4")) {
-#'   data(mtcars)
-#'   data(sleepstudy)
+#' @examplesIf require("lme4", quietly = TRUE)
+#' data(mtcars)
+#' data(sleepstudy, package = "lme4")
 #'
-#'   m1 <- lm(mpg ~ wt + cyl + vs, data = mtcars)
-#'   m2 <- lm(mpg ~ wt + cyl, data = mtcars)
-#'   m3 <- lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
-#'   m4 <- glm(formula = vs ~ wt, family = binomial(), data = mtcars)
+#' m1 <- lm(mpg ~ wt + cyl + vs, data = mtcars)
+#' m2 <- lm(mpg ~ wt + cyl, data = mtcars)
+#' m3 <- lme4::lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
+#' m4 <- glm(formula = vs ~ wt, family = binomial(), data = mtcars)
 #'
-#'   all_models_same_class(m1, m2)
-#'   all_models_same_class(m1, m2, m3)
-#'   all_models_same_class(m1, m4, m2, m3, verbose = TRUE)
-#'   all_models_same_class(m1, m4, mtcars, m2, m3, verbose = TRUE)
-#' }
+#' all_models_same_class(m1, m2)
+#' all_models_same_class(m1, m2, m3)
+#' all_models_same_class(m1, m4, m2, m3, verbose = TRUE)
+#' all_models_same_class(m1, m4, mtcars, m2, m3, verbose = TRUE)
 #' @export
 all_models_equal <- function(..., verbose = FALSE) {
   objects <- list(...)

diff --git a/R/clean_names.R b/R/clean_names.R
@@ -23,7 +23,7 @@
 #'   vector, while `find_variables()` returns a list of character
 #'   vectors, unless `flatten = TRUE`. See 'Examples'.
 #'
-#' @examples
+#' @examplesIf require("lme4", quietly = TRUE)
 #' # example from ?stats::glm
 #' counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12)
 #' outcome <- as.numeric(gl(3, 1, 9))
@@ -32,17 +32,16 @@
 #' clean_names(m)
 #'
 #' # difference "clean_names()" and "find_variables()"
-#' if (require("lme4")) {
-#'   m <- glmer(
-#'     cbind(incidence, size - incidence) ~ period + (1 | herd),
-#'     data = cbpp,
-#'     family = binomial
-#'   )
+#' data(cbpp, package = "lme4")
+#' m <- lme4::glmer(
+#'   cbind(incidence, size - incidence) ~ period + (1 | herd),
+#'   data = cbpp,
+#'   family = binomial
+#' )
 #'
-#'   clean_names(m)
-#'   find_variables(m)
-#'   find_variables(m, flatten = TRUE)
-#' }
+#' clean_names(m)
+#' find_variables(m)
+#' find_variables(m, flatten = TRUE)
 #' @export
 clean_names <- function(x, ...) {
   UseMethod("clean_names")

diff --git a/R/clean_parameters.R b/R/clean_parameters.R
@@ -27,12 +27,12 @@
 #' The `Effects` column indicate if a parameter is a *fixed* or *random* effect.
 #' The `Component` can either be *conditional* or *zero_inflated*. For models
 #' with random effects, the `Group` column indicates the grouping factor of the
-#' random effects. For multivariate response models from **brms** or
-#' **rstanarm**, an additional *Response* column is included, to indicate
+#' random effects. For multivariate response models from {brms} or
+#' {rstanarm}, an additional *Response* column is included, to indicate
 #' which parameters belong to which response formula. Furthermore,
 #' *Cleaned_Parameter* column is returned that contains "human readable"
 #' parameter names (which are mostly identical to `Parameter`, except for for
-#' models from **brms** or **rstanarm**, or for specific terms like smooth-
+#' models from {brms} or {rstanarm}, or for specific terms like smooth-
 #' or spline-terms).
 #'
 #' @examplesIf require("curl", quietly = TRUE) && curl::has_internet() && require("brms")

diff --git a/R/compute_variances.R b/R/compute_variances.R
@@ -14,7 +14,7 @@
 
   faminfo <- model_info(x, verbose = FALSE)
 
-  if (faminfo$family %in% c("truncated_nbinom1")) {
+  if (any(faminfo$family == "truncated_nbinom1")) {
     if (verbose) {
       format_warning(sprintf(
         "Truncated negative binomial families are currently not supported by `%s`.",
@@ -140,15 +140,15 @@
 
 
   compact_list(list(
-    "var.fixed" = var.fixed,
-    "var.random" = var.random,
-    "var.residual" = var.residual,
-    "var.distribution" = var.distribution,
-    "var.dispersion" = var.dispersion,
-    "var.intercept" = var.intercept,
-    "var.slope" = var.slope,
-    "cor.slope_intercept" = cor.slope_intercept,
-    "cor.slopes" = cor.slopes
+    var.fixed = var.fixed,
+    var.random = var.random,
+    var.residual = var.residual,
+    var.distribution = var.distribution,
+    var.dispersion = var.dispersion,
+    var.intercept = var.intercept,
+    var.slope = var.slope,
+    cor.slope_intercept = cor.slope_intercept,
+    cor.slopes = cor.slopes
   ))
 }
 
@@ -308,12 +308,12 @@
     vc <- lapply(names(lme4::VarCorr(x)), function(i) {
       element <- lme4::VarCorr(x)[[i]]
       if (i != "residual__") {
-        if (!is.null(element$cov)) {
-          out <- as.matrix(drop(element$cov[, 1, ]))
-          colnames(out) <- rownames(out) <- gsub("Intercept", "(Intercept)", rownames(element$cov), fixed = TRUE)
-        } else {
+        if (is.null(element$cov)) {
           out <- as.matrix(drop(element$sd[, 1])^2)
           colnames(out) <- rownames(out) <- gsub("Intercept", "(Intercept)", rownames(element$sd), fixed = TRUE)
+        } else {
+          out <- as.matrix(drop(element$cov[, 1, ]))
+          colnames(out) <- rownames(out) <- gsub("Intercept", "(Intercept)", rownames(element$cov), fixed = TRUE)
         }
         attr(out, "sttdev") <- element$sd[, 1]
       } else {
@@ -600,7 +600,9 @@
   .null_model <- null_model(x, verbose = verbose)
 
   # check if null-model could be computed
-  if (!is.null(.null_model)) {
+  if (is.null(.null_model)) {
+    mu <- NA
+  } else {
     if (inherits(.null_model, "cpglmm")) {
       # installed?
       check_if_installed("cplm")
@@ -609,8 +611,6 @@
       null_fixef <- unname(.collapse_cond(lme4::fixef(.null_model)))
     }
     mu <- exp(null_fixef)
-  } else {
-    mu <- NA
   }
 
   if (is.na(mu)) {

diff --git a/R/export_table.R b/R/export_table.R
@@ -602,7 +602,7 @@ print.insight_table <- function(x, ...) {
   }
 
   # Transform table matrix into a string value that can be printed
-  rows <- .table_parts(c(), final, header, sep, cross, empty_line)
+  rows <- .table_parts(NULL, final, header, sep, cross, empty_line)
 
   # if we have over-lengthy tables that are split into two parts,
   # print second table here
@@ -622,13 +622,13 @@ print.insight_table <- function(x, ...) {
     if (length(caption) == 2 && .is_valid_colour(caption[2])) {
       caption <- .colour(caption[2], caption[1])
     }
-    if (!is.null(subtitle)) {
+    if (is.null(subtitle)) {
+      subtitle <- ""
+    } else {
       # if we have a colour value, make coloured ansi-string
       if (length(subtitle) == 2 && .is_valid_colour(subtitle[2])) {
         subtitle <- .colour(subtitle[2], subtitle[1])
       }
-    } else {
-      subtitle <- ""
     }
 
     # paste everything together and remove unnecessary double spaces
@@ -1008,8 +1008,8 @@ print.insight_table <- function(x, ...) {
         col_align <- c(
           col_align,
           switch(substr(align, i, i),
-            "l" = "left",
-            "r" = "right",
+            l = "left",
+            r = "right",
             "center"
           )
         )

diff --git a/R/find_algorithm.R b/R/find_algorithm.R
@@ -24,7 +24,7 @@
 #'   - `iterations`, number of iterations per chain
 #'   - `warmup`, number of warmups per chain
 #'
-#' @examplesIf require("lme4")
+#' @examplesIf require("lme4", quietly = TRUE)
 #' data(sleepstudy, package = "lme4")
 #' m <- lme4::lmer(Reaction ~ Days + (1 | Subject), data = sleepstudy)
 #' find_algorithm(m)

diff --git a/R/find_formula.R b/R/find_formula.R
@@ -2,69 +2,67 @@
 #' @name find_formula
 #'
 #' @description Returns the formula(s) for the different parts of a model
-#'    (like fixed or random effects, zero-inflated component, ...).
-#'    `formula_ok()` checks if a model formula has valid syntax
-#'    regarding writing `TRUE` instead of `T` inside `poly()`
-#'    and that no data names are used (i.e. no `data$variable`, but rather
-#'    `variable`).
+#'  (like fixed or random effects, zero-inflated component, ...).
+#'  `formula_ok()` checks if a model formula has valid syntax
+#'  regarding writing `TRUE` instead of `T` inside `poly()`
+#'  and that no data names are used (i.e. no `data$variable`, but rather
+#'  `variable`).
 #'
 #' @param verbose Toggle warnings.
 #' @param ... Currently not used.
 #' @inheritParams find_predictors
 #'
 #' @return A list of formulas that describe the model. For simple models,
-#'    only one list-element, `conditional`, is returned. For more complex
-#'    models, the returned list may have following elements:
+#'  only one list-element, `conditional`, is returned. For more complex
+#'  models, the returned list may have following elements:
 #'
-#'    - `conditional`, the "fixed effects" part from the model (in the
-#'      context of fixed-effects or instrumental variable regression, also
-#'      called *regressors*) . One exception are `DirichletRegModel` models
-#'      from \pkg{DirichletReg}, which has two or three components,
-#'      depending on `model`.
+#'  - `conditional`, the "fixed effects" part from the model (in the
+#'    context of fixed-effects or instrumental variable regression, also
+#'    called *regressors*) . One exception are `DirichletRegModel` models
+#'    from {DirichletReg}, which has two or three components,
+#'    depending on `model`.
 #'
-#'    - `random`, the "random effects" part from the model (or the
-#'      `id` for gee-models and similar)
+#'  - `random`, the "random effects" part from the model (or the
+#'    `id` for gee-models and similar)
 #'
-#'    - `zero_inflated`, the "fixed effects" part from the
-#'      zero-inflation component of the model
+#'  - `zero_inflated`, the "fixed effects" part from the
+#'    zero-inflation component of the model
 #'
-#'    - `zero_inflated_random`, the "random effects" part from the
-#'      zero-inflation component of the model
+#'  - `zero_inflated_random`, the "random effects" part from the
+#'    zero-inflation component of the model
 #'
-#'    - `dispersion`, the dispersion formula
+#'  - `dispersion`, the dispersion formula
 #'
-#'    - `instruments`, for fixed-effects or instrumental variable
-#'      regressions like `ivreg::ivreg()`, `lfe::felm()` or `plm::plm()`,
-#'      the instrumental variables
+#'  - `instruments`, for fixed-effects or instrumental variable
+#'    regressions like `ivreg::ivreg()`, `lfe::felm()` or `plm::plm()`,
+#'    the instrumental variables
 #'
-#'    - `cluster`, for fixed-effects regressions like
-#'      `lfe::felm()`, the cluster specification
+#'  - `cluster`, for fixed-effects regressions like
+#'    `lfe::felm()`, the cluster specification
 #'
-#'    - `correlation`, for models with correlation-component like
-#'      `nlme::gls()`, the formula that describes the correlation structure
+#'  - `correlation`, for models with correlation-component like
+#'    `nlme::gls()`, the formula that describes the correlation structure
 #'
-#'    - `slopes`, for fixed-effects individual-slope models like
-#'      `feisr::feis()`, the formula for the slope parameters
+#'  - `slopes`, for fixed-effects individual-slope models like
+#'    `feisr::feis()`, the formula for the slope parameters
 #'
-#'    - `precision`, for `DirichletRegModel` models from
-#'      \pkg{DirichletReg}, when parametrization (i.e. `model`) is
-#'      `"alternative"`.
+#'  - `precision`, for `DirichletRegModel` models from
+#'    {DirichletReg}, when parametrization (i.e. `model`) is
+#'    `"alternative"`.
 #'
 #' @note For models of class `lme` or `gls` the correlation-component
 #'   is only returned, when it is explicitly defined as named argument
 #'   (`form`), e.g. `corAR1(form = ~1 | Mare)`
 #'
-#' @examples
+#' @examplesIf require("lme4", quietly = TRUE)
 #' data(mtcars)
 #' m <- lm(mpg ~ wt + cyl + vs, data = mtcars)
 #' find_formula(m)
 #'
-#' if (require("lme4")) {
-#'   m <- lmer(Sepal.Length ~ Sepal.Width + (1 | Species), data = iris)
-#'   f <- find_formula(m)
-#'   f
-#'   format(f)
-#' }
+#' m <- lme4::lmer(Sepal.Length ~ Sepal.Width + (1 | Species), data = iris)
+#' f <- find_formula(m)
+#' f
+#' format(f)
 #' @export
 find_formula <- function(x, verbose = TRUE, ...) {
   UseMethod("find_formula")
@@ -566,14 +564,14 @@ find_formula.RM <- find_formula.MANOVA
 find_formula.gls <- function(x, verbose = TRUE, ...) {
   ## TODO this is an intermediate fix to return the correlation variables from gls-objects
   fcorr <- x$call$correlation
-  if (!is.null(fcorr)) {
+  if (is.null(fcorr)) {
+    f_corr <- NULL
+  } else {
     if (inherits(fcorr, "name")) {
       f_corr <- attributes(eval(fcorr))$formula
     } else {
       f_corr <- parse(text = safe_deparse(fcorr))[[1]]
     }
-  } else {
-    f_corr <- NULL
   }
   if (is.symbol(f_corr)) {
     f_corr <- paste("~", safe_deparse(f_corr))
@@ -1274,14 +1272,14 @@ find_formula.lme <- function(x, verbose = TRUE, ...) {
   }
   ## TODO this is an intermediate fix to return the correlation variables from lme-objects
   fcorr <- x$call$correlation
-  if (!is.null(fcorr)) {
+  if (is.null(fcorr)) {
+    fc <- NULL
+  } else {
     if (inherits(fcorr, "name")) {
       fc <- attributes(eval(fcorr))$formula
     } else {
       fc <- parse(text = safe_deparse(fcorr))[[1]]$form
     }
-  } else {
-    fc <- NULL
   }
 
   f <- compact_list(list(
@@ -1315,11 +1313,11 @@ find_formula.mixor <- function(x, verbose = TRUE, ...) {
   f_id <- deparse(x$call$id)
   f_rs <- x$call$which.random.slope
 
-  if (!is.null(f_rs)) {
+  if (is.null(f_rs)) {
+    fmr <- f_id
+  } else {
     f_rs <- trim_ws(unlist(strsplit(safe_deparse(x$call$formula[[3]]), "+", fixed = TRUE), use.names = FALSE))[f_rs]
     fmr <- paste(f_rs, "|", f_id)
-  } else {
-    fmr <- f_id
   }
 
   fmr <- stats::as.formula(paste("~", fmr))
@@ -1491,7 +1489,10 @@ find_formula.BFBayesFactor <- function(x, verbose = TRUE, ...) {
     dt <- utils::tail(x@numerator, 1)[[1]]@dataTypes
     frand <- names(dt)[which(dt == "random")]
 
-    if (!is_empty_object(frand)) {
+    if (is_empty_object(frand)) {
+      f.random <- NULL
+      f.cond <- stats::as.formula(fcond)
+    } else {
       f.random <- stats::as.formula(paste0("~", paste(frand, collapse = " + ")))
       for (i in frand) {
         fcond <- sub(i, "", fcond, fixed = TRUE)
@@ -1507,9 +1508,6 @@ find_formula.BFBayesFactor <- function(x, verbose = TRUE, ...) {
         fcond <- paste(fcond, "1")
       }
       f.cond <- stats::as.formula(trim_ws(fcond))
-    } else {
-      f.random <- NULL
-      f.cond <- stats::as.formula(fcond)
     }
   } else if (.classify_BFBayesFactor(x) %in% c("ttest1", "ttest2")) {
     f.cond <- .safe(stats::as.formula(x@numerator[[1]]@identifier$formula))