Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fix compact_list() for labelled + other vctrs classes #880

Open
wants to merge 15 commits into
base: main
Choose a base branch
from
6 changes: 3 additions & 3 deletions CRAN-SUBMISSION
Original file line number Diff line number Diff line change
@@ -1,3 +1,3 @@
Version: 0.19.11
Date: 2024-05-12 17:57:07 UTC
SHA: b850f730c05480293504a2b81217d9244de20f3e
Version: 0.20.0
Date: 2024-06-03 12:54:55 UTC
SHA: 40c4fbce021ca275d823719e60f74717ff61f33d
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Type: Package
Package: insight
Title: Easy Access to Model Information for Various Model Objects
Version: 0.19.11.5
Version: 0.20.0
Authors@R:
c(person(given = "Daniel",
family = "Lüdecke",
11 changes: 9 additions & 2 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
# insight 0.19.12
# insight 0.20.0

## Breaking

@@ -10,6 +10,13 @@
* `get_datagrid()`
* `print_parameters()`

## Bug fixes

* Fixed errors in CRAN checks.

* Fixed issues in `compact_list()` for objects that contained variables of
class `vctrs`.

# insight 0.19.11

## General
@@ -19,7 +26,7 @@

## Bug fixes

* Fixed issue with `get_data()` for `coxme` models when `source`was set to
* Fixed issue with `get_data()` for `coxme` models when `source` was set to
`"modelframe"`.

# insight 0.19.10
5 changes: 5 additions & 0 deletions R/get_response.R
Original file line number Diff line number Diff line change
@@ -38,7 +38,7 @@

#' @rdname get_response
#' @export
get_response.default <- function(x, select = NULL, as_proportion = TRUE, source = "environment", verbose = TRUE, ...) {

Check warning on line 41 in R/get_response.R

GitHub Actions / lint-changed-files / lint-changed-files

file=R/get_response.R,line=41,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this function from 45 to at most 40.
rn <- find_response(x, combine = FALSE)
combined_rn <- find_response(x, combine = TRUE)

@@ -75,6 +75,11 @@
!is.matrix(response)) {
response <- as.vector(response)
}

# clear vctr-class attributes
if (inherits(response, "vctrs_vctr")) {
class(response) <- setdiff(class(response), c("haven_labelled", "vctrs_vctr"))
}
response
}

6 changes: 3 additions & 3 deletions R/utils_compact.R
Original file line number Diff line number Diff line change
@@ -10,9 +10,9 @@
#' @export
compact_list <- function(x, remove_na = FALSE) {
if (remove_na) {
x[!sapply(x, function(i) !is_model(i) && !inherits(i, c("Formula", "gFormula")) && (length(i) == 0L || is.null(i) || (length(i) == 1L && is.na(i)) || all(is.na(i)) || any(i == "NULL", na.rm = TRUE)))]
x[!sapply(x, function(i) !is_model(i) && !inherits(i, c("Formula", "gFormula")) && (length(i) == 0L || is.null(i) || (length(i) == 1L && is.na(i)) || all(is.na(i)) || all(sapply(i, is.null)) || any(sapply(i, \(j) length(j) == 1 && is.character(j) && j == "NULL"), na.rm = TRUE)))]

Check warning on line 13 in R/utils_compact.R

GitHub Actions / lint-changed-files / lint-changed-files

file=R/utils_compact.R,line=13,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 284 characters.
Copy link
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We shouldn't use lambdas here due to backwards compatibility.

} else {
x[!sapply(x, function(i) !is_model(i) && !inherits(i, c("Formula", "gFormula")) && (length(i) == 0L || is.null(i) || any(i == "NULL", na.rm = TRUE)))]
x[!sapply(x, function(i) !is_model(i) && !inherits(i, c("Formula", "gFormula")) && (length(i) == 0L || is.null(i) || all(sapply(i, is.null)) || any(sapply(i, \(j) length(j) == 1 && is.character(j) && j == "NULL"), na.rm = TRUE)))]

Check warning on line 15 in R/utils_compact.R

GitHub Actions / lint-changed-files / lint-changed-files

file=R/utils_compact.R,line=15,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 234 characters.
}
}

@@ -30,5 +30,5 @@
#'
#' @export
compact_character <- function(x) {
x[!sapply(x, function(i) nchar(i) == 0 || all(is.na(i)) || any(i == "NULL", na.rm = TRUE))]
x[!sapply(x, function(i) !nzchar(i, keepNA = TRUE) || all(is.na(i)) || any(i == "NULL", na.rm = TRUE))]
}
10 changes: 9 additions & 1 deletion cran-comments.md
Original file line number Diff line number Diff line change
@@ -1 +1,9 @@
This release is required for the planned update of the 'parameters' package, which will be released once 'insight' is on CRAN. The 'parameters' update fixes errors in CRAN checks.
This release fixes errors in CRAN checks.

Additionally, in the process of stabilizing the API/user interface for packages
from the 'easystats' project, some argument names were renamed and old names
have been deprecated. This will *not break* downstream dependent packages, however,
reverse-dependency checks will raise warnings. We have already patched all
affected downstream packages and will submit them to CRAN in the next few days,
after the release of 'insight'. Once this release-cycle is complete, all
warnings due to deprecated argument names should be resolved.
22 changes: 11 additions & 11 deletions tests/testthat/test-compact-list.R
Original file line number Diff line number Diff line change
@@ -1,19 +1,19 @@
test_that("compact_list works as expected", {
expect_equal(compact_list(list(NULL, 1, c(NA, NA))), list(1, c(NA, NA)))
expect_equal(compact_list(c(1, NA, NA)), c(1, NA, NA))
expect_equal(compact_list(list(NULL, 1, list(NULL, NULL))), list(1))
expect_equal(compact_list(c(1, NA, NA), remove_na = TRUE), 1)
expect_equal(compact_list(c(1, 2, 3), remove_na = TRUE), c(1, 2, 3))
expect_equal(compact_list(""), "")
expect_identical(compact_list(list(NULL, 1, c(NA, NA))), list(1, c(NA, NA)))
expect_identical(compact_list(c(1, NA, NA)), c(1, NA, NA))
expect_identical(compact_list(list(NULL, 1, list(NULL, NULL))), list(1))
expect_identical(compact_list(c(1, NA, NA), remove_na = TRUE), 1)
expect_identical(compact_list(c(1, 2, 3), remove_na = TRUE), c(1, 2, 3))
expect_identical(compact_list(""), "")
expect_null(compact_list(NULL))
expect_equal(compact_list(logical(0)), logical(0))
expect_identical(compact_list(logical(0)), logical(0))
})

test_that("compact_list, logical > 1", {
x <- list(a = 1, b = c(1, 2), c = NA)
expect_equal(compact_list(x, remove_na = TRUE), list(a = 1, b = c(1, 2)))
expect_equal(compact_list(x, remove_na = FALSE), list(a = 1, b = c(1, 2), c = NA))
expect_identical(compact_list(x, remove_na = TRUE), list(a = 1, b = c(1, 2)))
expect_identical(compact_list(x, remove_na = FALSE), list(a = 1, b = c(1, 2), c = NA))
x <- list(a = 1, b = c(NA, NA), c = NA)
expect_equal(compact_list(x, remove_na = TRUE), list(a = 1))
expect_equal(compact_list(x, remove_na = FALSE), list(a = 1, b = c(NA, NA), c = NA))
expect_identical(compact_list(x, remove_na = TRUE), list(a = 1))
expect_identical(compact_list(x, remove_na = FALSE), list(a = 1, b = c(NA, NA), c = NA))
})
1 change: 1 addition & 0 deletions tests/testthat/test-fixest.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
# Currently doesn't work on devel - potential fixest issue?
skip_if(TRUE)

skip_on_os("mac")

Unchanged files with check annotations Beta

# utils ---------------------
.remove_pattern_from_names <- function(x,

Check warning on line 106 in R/clean_names.R

GitHub Actions / lint / lint

file=R/clean_names.R,line=106,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this function from 43 to at most 40.
ignore_asis = FALSE,
ignore_lag = FALSE,
is_emmeans = FALSE) {
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)

Check warning on line 531 in R/clean_parameters.R

GitHub Actions / lint / lint

file=R/clean_parameters.R,line=531,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 123 characters.
# correlation and sd
# 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)

Check warning on line 542 in R/clean_parameters.R

GitHub Actions / lint / lint

file=R/clean_parameters.R,line=542,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 134 characters.
}
}
simplex <- startsWith(out$Cleaned_Parameter, "simo_")
if (length(simplex)) {
out$Cleaned_Parameter[simplex] <- gsub("^(simo_|simo_mo)(.*)\\[(\\d)\\]$", "\\2[\\3]", out$Cleaned_Parameter[simplex])

Check warning on line 588 in R/clean_parameters.R

GitHub Actions / lint / lint

file=R/clean_parameters.R,line=588,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 122 characters.
out$Component[simplex] <- "simplex"
}
return(FALSE)
}
if ((cols <- Sys.getenv("RSTUDIO_CONSOLE_COLOR", "")) != "" && !is.na(as.numeric(cols))) {

Check warning on line 6 in R/colour_tools.R

GitHub Actions / lint / lint

file=R/colour_tools.R,line=6,col=8,[implicit_assignment_linter] Avoid implicit assignments in function calls. For example, instead of `if (x <- 1L) { ... }`, write `x <- 1L; if (x) { ... }`.
return(TRUE)
}
# tools -----------------------------------
.colour <- function(colour = "red", x) {

Check warning on line 191 in R/colour_tools.R

GitHub Actions / lint / lint

file=R/colour_tools.R,line=191,col=37,[function_argument_linter] Arguments without defaults should come before arguments with defaults.
# replace "bright" suffixes to a generic color code
if (grepl("^(bright_|br_)", colour)) {
colour <- gsub("^(bright_|br_)", "b", colour)
if (.is_singular(x, vals, tolerance = tolerance) && !(component %in% c("slope", "intercept"))) {
if (verbose) {
format_warning(
sprintf("Can't compute %s. Some variance components equal zero. Your model may suffer from singularity (see `?lme4::isSingular` and `?performance::check_singularity`).", name_full),

Check warning on line 42 in R/compute_variances.R

GitHub Actions / lint / lint

file=R/compute_variances.R,line=42,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 189 characters.
"Solution: Respecify random structure! You may also decrease the `tolerance` level to enforce the calculation of random effect variances."

Check warning on line 43 in R/compute_variances.R

GitHub Actions / lint / lint

file=R/compute_variances.R,line=43,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 146 characters.
)
}
no_random_variance <- TRUE
if (faminfo$is_zero_inflated) {
.variance_zip(x, faminfo, family_var = mu)
} else if (inherits(x, "MixMod")) {
return(mu)

Check warning on line 720 in R/compute_variances.R

GitHub Actions / lint / lint

file=R/compute_variances.R,line=720,col=5,[return_linter] Use implicit return behavior; explicit return() is not needed.
} else if (inherits(x, "cpglmm")) {
.get_cplm_family(x)$variance(mu)
} else {
if (length(rs) > length(fe)) rs <- rs[seq_along(fe)]
if (length(fe) > length(rs)) fe <- fe[seq_along(rs)]
all(mapply(function(r, f) all(r %in% f), rs, fe, SIMPLIFY = TRUE))

Check warning on line 932 in R/compute_variances.R

GitHub Actions / lint / lint

file=R/compute_variances.R,line=932,col=7,[undesirable_function_linter] Avoid undesirable function "mapply".
}