Skip to content

Commit

Permalink
fix
Browse files Browse the repository at this point in the history
  • Loading branch information
strengejacke committed Sep 17, 2024
1 parent 8dd0b65 commit 2f17e45
Show file tree
Hide file tree
Showing 4 changed files with 36 additions and 3 deletions.
2 changes: 1 addition & 1 deletion R/equivalence_test.R
Original file line number Diff line number Diff line change
Expand Up @@ -168,7 +168,7 @@ equivalence_test.data.frame <- function(x, range = "default", ci = 0.95, rvar_co
# multiple ranges for the parameters - iterate over parameters and range
if (is.list(range)) {
# check if list of values contains only valid values
.check_list_range(range, x)
range <- .check_list_range(range, x)
# apply thresholds to each column
l <- insight::compact_list(mapply(

Check warning on line 173 in R/equivalence_test.R

View workflow job for this annotation

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

file=R/equivalence_test.R,line=173,col=32,[undesirable_function_linter] Avoid undesirable function "mapply".
function(p, r) {
Expand Down
21 changes: 20 additions & 1 deletion R/p_significance.R
Original file line number Diff line number Diff line change
Expand Up @@ -138,7 +138,7 @@ p_significance.data.frame <- function(x, threshold = "default", rvar_col = NULL,
ps <- .p_significance(x[, 1], threshold = threshold, ...)
} else if (is.list(threshold)) {
# check if list of values contains only valid values
.check_list_range(threshold, x, larger_two = TRUE)
threshold <- .check_list_range(threshold, x, larger_two = TRUE)
# apply thresholds to each column
ps <- mapply(

Check warning on line 143 in R/p_significance.R

View workflow job for this annotation

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

file=R/p_significance.R,line=143,col=11,[undesirable_function_linter] Avoid undesirable function "mapply".
function(p, thres) {
Expand Down Expand Up @@ -417,6 +417,24 @@ as.double.p_significance <- as.numeric.p_significance
}

.check_list_range <- function(range, params, larger_two = FALSE) {
# if we have named elements, complete list
named_range <- names(range)
if (!is.null(named_range)) {
# find out which name belongs to which parameter
pos <- match(named_range, colnames(params))
# if not all element names were found, error
if (anyNA(pos)) {
insight::format_error(paste(
"Not all elements of `range` were found in the parameters. Please check following names:",
toString(names_range[is.na])
))
}
# now "fill" non-specified elements with "default"
out <- rep("default", ncol(params))
out[pos] <- range
# overwrite former range
range <- out
}
if (length(range) != ncol(params)) {
insight::format_error("Length of `range` (i.e. number of ROPE limits) should match the number of parameters.")
}
Expand All @@ -431,4 +449,5 @@ as.double.p_significance <- as.numeric.p_significance
if (!all(checks)) {
insight::format_error("`range` should be 'default' or a vector of 2 numeric values (e.g., c(-0.1, 0.1)).")
}
range
}
2 changes: 1 addition & 1 deletion R/rope.R
Original file line number Diff line number Diff line change
Expand Up @@ -613,7 +613,7 @@ rope.sim <- function(x, range = "default", ci = 0.95, ci_method = "ETI", paramet
.prepare_rope_df <- function(parms, range, ci, ci_method, verbose) {
if (is.list(range)) {
# check if list of values contains only valid values
.check_list_range(range, parms)
range <- .check_list_range(range, parms)
# apply thresholds to each column
tmp <- mapply(
function(p, r) {
Expand Down
14 changes: 14 additions & 0 deletions tests/testthat/test-rope.R
Original file line number Diff line number Diff line change
Expand Up @@ -50,6 +50,20 @@ test_that("rope", {
tolerance = 1e-3
)

# list range
expect_equal(
rope(m, range = list(c(-1, 0.1), "default", "default", c(-1, 1), c(-1.5, -1)))$ROPE_Percentage,
c(0.15823, 1, 0, 0.3903, 0.38186)
tolerance = 1e-3
)

# named elements, chooses "default" for unnamed
expect_equal(
rope(m, range = list(c(-1, 0.1), "default", "default", c(-1, 1), c(-1.5, -1)))$ROPE_Percentage,
rope(m, range = list("(Intercept)" = c(-1, 0.1), period4 = c(-1.5, -1), period3 = c(-1, 1)))$ROPE_Percentage,
tolerance = 1e-3
)

expect_error(
rope(m, range = list(c(-0.1, 0.1), c(2, 2))),
regex = "Length of"
Expand Down

0 comments on commit 2f17e45

Please sign in to comment.