New tests with help from gpttools

This commit is contained in:
AG Damsbo 2023-01-03 14:12:29 +01:00
parent 0cee325112
commit 6098335cea
2 changed files with 16 additions and 2 deletions

View File

@ -2,4 +2,5 @@ test_that("generic_stroke() runs!", {
iris$ord<-factor(sample(1:3,size=nrow(iris),replace=TRUE),ordered=TRUE)
result <- generic_stroke(df=iris, group = "Species", score = "ord", variables = colnames(iris)[1:3])
expect_equal(length(result), 3)
expect_equal(class(result), "list")
})

View File

@ -13,3 +13,16 @@ test_that("quatile_cut() works for detail.list==FALSE", {
})
################################################################################
# Test created using remotes::install_github("JamesHWade/gpttools") unit test addin.
test_that("quantile_cut works correctly", {
x <- runif(100)
groups <- 5
y <- runif(100)
expect_equal(quantile_cut(x, groups, y, na.rm = TRUE),
cut(x, quantile(y, probs = seq(0, 1, 1/groups), na.rm = TRUE, names = TRUE, type = 7),
include.lowest = TRUE, labels = NULL, ordered_result = FALSE))
})
################################################################################