Skip to content

Strip by of tokens before attempting removal #1157

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.

Sign up for GitHub

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

Open
ryanzomorrodi wants to merge 1 commit into
base: main
Choose a base branch
from
+33 −2
Open

Strip by of tokens before attempting removal #1157

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 9 additions & 2 deletions R/get_datagrid.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -304,7 +304,7 @@

#' @rdname get_datagrid
#' @export
get_datagrid.data.frame <- function(

Check warning on line 307 in R/get_datagrid.R

View workflow job for this annotation

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

file=R/get_datagrid.R,line=307,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this expression from 63 to at most 40. Consider replacing high-complexity sections like loops and branches with helper functions.
x,
by = "all",
factors = "reference",
Expand Down Expand Up @@ -539,7 +539,7 @@

if (nrow(targets) == 0) {
format_error(
"No data left was left after range preservation. Try increasing `length` or setting `preserve_range` to `FALSE`."

Check warning on line 542 in R/get_datagrid.R

View workflow job for this annotation

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

file=R/get_datagrid.R,line=542,col=121,[line_length_linter] Lines should not be more than 120 characters. This line is 123 characters.
)
}
}
Expand Down Expand Up @@ -747,6 +747,13 @@

# check for interactions in "by"
by <- .extract_at_interactions(by)
by_stripped <- vapply(
by,
function(by_var) {
.get_datagrid_clean_target(by_var, x = data, digits = digits)$varname
},
character(1)
)

# Drop random factors
random_factors <- find_random(x, flatten = TRUE, split_nested = TRUE)
Expand All @@ -756,8 +763,8 @@
keep <- c(find_predictors(x, effects = "fixed", flatten = TRUE), response)
if (!is.null(keep)) {
if (all(by != "all")) {
keep <- c(keep, by[by %in% random_factors])
random_factors <- setdiff(random_factors, by)
keep <- c(keep, by_stripped[by_stripped %in% random_factors])
random_factors <- setdiff(random_factors, by_stripped)
}
data <- data[colnames(data) %in% keep]
}
Expand Down Expand Up @@ -1005,7 +1012,7 @@
# e.g. `by="mpg=c(20,30,40)"` or `by="mpg=[sd]"`

#' @keywords internal
.get_datagrid_clean_target <- function(x, by = NULL, digits = 3, ...) {

Check warning on line 1015 in R/get_datagrid.R

View workflow job for this annotation

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

file=R/get_datagrid.R,line=1015,col=1,[cyclocomp_linter] Reduce the cyclomatic complexity of this expression from 53 to at most 40. Consider replacing high-complexity sections like loops and branches with helper functions.
by_expression <- NA
varname <- NA
original_target <- by
Expand Down Expand Up @@ -1443,7 +1450,7 @@
}

# If Range is an interval
if (range == "iqr") {

Check warning on line 1453 in R/get_datagrid.R

View workflow job for this annotation

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

file=R/get_datagrid.R,line=1453,col=3,[if_switch_linter] Prefer switch() statements over repeated if/else equality tests, e.g., switch(x, a = 1, b = 2) over if (x == "a") 1 else if (x == "b") 2.
# nolint
mini <- stats::quantile(x, (1 - ci) / 2, ...)
maxi <- stats::quantile(x, (1 + ci) / 2, ...)
Expand Down
24 changes: 24 additions & 0 deletions tests/testthat/test-get_datagrid.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -129,9 +129,9 @@
Mean = 1.1993,
`+1 SD` = 1.9616,
`-1 SD` = 0.4371, # nolint
Mean = 1.1993,

Check warning on line 132 in tests/testthat/test-get_datagrid.R

View workflow job for this annotation

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

file=tests/testthat/test-get_datagrid.R,line=132,col=7,[duplicate_argument_linter] Avoid duplicate arguments in function calls.
`+1 SD` = 1.9616,

Check warning on line 133 in tests/testthat/test-get_datagrid.R

View workflow job for this annotation

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

file=tests/testthat/test-get_datagrid.R,line=133,col=7,[duplicate_argument_linter] Avoid duplicate arguments in function calls.
`-1 SD` = 0.4371,

Check warning on line 134 in tests/testthat/test-get_datagrid.R

View workflow job for this annotation

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

file=tests/testthat/test-get_datagrid.R,line=134,col=7,[duplicate_argument_linter] Avoid duplicate arguments in function calls.
Mean = 1.1993, # nolint
`+1 SD` = 1.9616 # nolint
),
Expand Down Expand Up @@ -822,6 +822,30 @@
expect_identical(out$cyl, c(NA, NA))
})

test_that("get_datagrid - by with tokened random effect", {
skip_if_not_installed("glmmTMB")

data(mtcars)
mtcars$vs <- as.factor(mtcars$vs)
model <- glmmTMB::glmmTMB(
mpg ~ vs + (1 | cyl),
data = mtcars
)
out <- get_datagrid(
model,
by = c("vs", "cyl = [minmax]")
)

expect_identical(
out$vs,
structure(c(1L, 1L, 2L), levels = c("0", "1"), class = "factor")
)
expect_identical(
out$cyl,
c(4, 8, 4)
)
})


test_that("get_datagrid - include_random works with interacting random effects", {
skip_if_not_installed("glmmTMB")
Expand Down Expand Up @@ -1083,7 +1107,7 @@
warpbreaks$sizegroup <- with(
warpbreaks,
factor(
ifelse(breaks < 26, "under26", ifelse(breaks > 34, ">34", "26<=34")),

Check warning on line 1110 in tests/testthat/test-get_datagrid.R

View workflow job for this annotation

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

file=tests/testthat/test-get_datagrid.R,line=1110,col=38,[nested_ifelse_linter] Don't use nested ifelse() calls; instead, try (1) data.table::fcase; (2) dplyr::case_when; or (3) using a lookup table.
levels = c("under26", "26<=34", ">34")
)
)
Expand Down
Loading