options(warnPartialMatchArgs = FALSE)
# Without this, underlying code in either stats or base R causes this warning in several places:
# warning: get_predictions works
# partial argument match of 'contrasts' to 'contrasts.arg'
test_df <- data.frame(
outcome = c("normal", "normal", "cancer"),
var1 = 1:3,
var2 = 4:6
)
test_that("split_outcome_features works", {
expect_equal(
split_outcome_features(test_df, "outcome"),
list(
outcome = data.frame(outcome = c("normal", "normal", "cancer")),
features = data.frame(
var1 = 1:3,
var2 = 4:6
)
)
)
})
test_that("randomize_feature_order works for known seed", {
reordered_df <- data.frame(
outcome = c("normal", "normal", "cancer"),
var2 = 4:6,
var1 = 1:3
)
set.seed(20)
expect_equal(
randomize_feature_order(test_df, "outcome"),
reordered_df
)
})
test_that("check if correct apply is selected", {
fa_installed <- all(check_packages_installed("future.apply"))
if (fa_installed) {
expect_equal(select_apply("lapply"), future.apply::future_lapply)
expect_equal(select_apply("sapply"), future.apply::future_sapply)
expect_equal(select_apply("apply"), future.apply::future_apply)
} else {
expect_equal(select_apply("lapply"), lapply)
expect_equal(select_apply("sapply"), sapply)
expect_equal(select_apply("apply"), apply)
}
})
test_that("mutate_all_types converts factors to other types", {
dat1 <- data.frame(
c1 = as.factor(c("a", "b", "c")),
c2 = as.factor(1:3),
c3 = as.factor(c(1.1, 1.2, 1.3))
)
dat2 <- mutate_all_types(dat1)
expect_equal(class(dat2$c1), "character")
expect_equal(class(dat2$c2), "integer")
expect_equal(class(dat2$c3), "numeric")
})
test_that("replace_spaces works", {
expect_equal(
replace_spaces(c("outcome 1", "outcome 2", "outcome 1")),
c("outcome_1", "outcome_2", "outcome_1")
)
expect_equal(
replace_spaces(c("no_spaces_here", "none")),
c("no_spaces_here", "none")
)
})
test_that("replace_spaces() doesn't modify non-character vectors", {
x <- 1:3
expect_equal(replace_spaces(x), x)
y <- c(1.1, 2.2, 3.3)
expect_equal(replace_spaces(y), y)
})
test_that("pbtick() updates the progress bar", {
f <- function() {
pb <- progressr::progressor(steps = 5)
pbtick(pb, message = "progress!")
}
expect_condition(expect_invisible(f()))
})
test_that("radix_sort() order is stable regardless of locale", {
locale <- Sys.getlocale("LC_COLLATE")
invisible(Sys.setlocale("LC_COLLATE", "en_US.UTF-8"))
sort_enus <- radix_sort(c(letters, LETTERS))
invisible(Sys.setlocale("LC_COLLATE", "C"))
sort_c <- radix_sort(c(letters, LETTERS))
expect_equal(sort_enus, sort_c)
invisible(Sys.setlocale("LC_COLLATE", locale))
})
test_that("is_whole_number() checks for integer numbers regardless of class", {
expect_true(all(is_whole_number(c(1, 2, 3))))
expect_false(is.integer(1))
expect_true(all(is_whole_number(c(1.0, 2.0, 3.0))))
expect_false(is_whole_number(1.2))
})
test_that("calc_pvalue() works", {
set.seed(123)
expect_equal(round(calc_pvalue(1:20, 10), digits = 3), 0.571)
expect_equal(calc_pvalue(c(1, 1, 1), 2), 0.25)
expect_equal(calc_pvalue(1:3, 0), 1)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.