From a47dca3ac7f7a2520f8d067c6dd158910218e71a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 2 Oct 2023 15:31:51 -0700 Subject: [PATCH 1/3] Fix test flakiness --- pkg/caret/tests/testthat/test_Dummies.R | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/pkg/caret/tests/testthat/test_Dummies.R b/pkg/caret/tests/testthat/test_Dummies.R index 77d608d35..d784c0f3f 100644 --- a/pkg/caret/tests/testthat/test_Dummies.R +++ b/pkg/caret/tests/testthat/test_Dummies.R @@ -120,15 +120,13 @@ check_dummies <- function(x, expected = NULL) { test_that("Good names for dummies with reocurring patterns", { + # Ensure this sample contains 1:15, which happens 98.5% of the time + repeat { + entry <- sample.int(15, size = 100, replace = TRUE, prob = rep(1 / 15, 15)) + if (length(unique(entry)) == 15L) break + } data = data.frame( - matrix( - rep( - as.factor(sample.int(15, size = 100, replace = TRUE, prob = rep(1 / 15, 15)) - ), - 15 - ), - ncol = 15 - ), + matrix(rep(as.factor(entry), 15L), ncol = 15), stringsAsFactors = TRUE ) essai_dummyVars = caret::dummyVars(stats::as.formula(paste0("~ ", colnames(data), collapse = "+")), data) @@ -137,4 +135,3 @@ test_that("Good names for dummies with reocurring patterns", { res_names_lvls <- colnames(predict(essai_dummyVars, data)) expect_true(all(exp_names_lvls %in% res_names_lvls)) }) - From ac3952f22991220bb45eef1fc591351d479e2a59 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 2 Oct 2023 15:36:44 -0700 Subject: [PATCH 2/3] Just double the sample size instead --- pkg/caret/tests/testthat/test_Dummies.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/pkg/caret/tests/testthat/test_Dummies.R b/pkg/caret/tests/testthat/test_Dummies.R index d784c0f3f..fe0b21c43 100644 --- a/pkg/caret/tests/testthat/test_Dummies.R +++ b/pkg/caret/tests/testthat/test_Dummies.R @@ -120,13 +120,16 @@ check_dummies <- function(x, expected = NULL) { test_that("Good names for dummies with reocurring patterns", { - # Ensure this sample contains 1:15, which happens 98.5% of the time - repeat { - entry <- sample.int(15, size = 100, replace = TRUE, prob = rep(1 / 15, 15)) - if (length(unique(entry)) == 15L) break - } + # 200 all but guarantees (99.999% chance) 1:15 all represented, #1350 data = data.frame( - matrix(rep(as.factor(entry), 15L), ncol = 15), + matrix( + rep( + as.factor(sample.int(15, size = 200, replace = TRUE, prob = rep(1 / 15, 15)) + ), + 15 + ), + ncol = 15 + ), stringsAsFactors = TRUE ) essai_dummyVars = caret::dummyVars(stats::as.formula(paste0("~ ", colnames(data), collapse = "+")), data) From 019b0a16d9acdf1dc658e706d0268d57cf51d91a Mon Sep 17 00:00:00 2001 From: topepo Date: Mon, 25 Nov 2024 13:47:48 -0500 Subject: [PATCH 3/3] added seed --- pkg/caret/tests/testthat/test_Dummies.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/pkg/caret/tests/testthat/test_Dummies.R b/pkg/caret/tests/testthat/test_Dummies.R index fe0b21c43..81535a6a8 100644 --- a/pkg/caret/tests/testthat/test_Dummies.R +++ b/pkg/caret/tests/testthat/test_Dummies.R @@ -108,9 +108,9 @@ check_dummies <- function(x, expected = NULL) { expect_equal(exp_names, res_names) foosbarsbars <- dummies <- dummyVars(formula = id ~., - data = test_data, - sep = '-', - levelsOnly = TRUE) + data = test_data, + sep = '-', + levelsOnly = TRUE) exp_names_lvls <- paste(1:9) res_names_lvls <- colnames(predict(foosbarsbars, test_data)) @@ -120,6 +120,7 @@ check_dummies <- function(x, expected = NULL) { test_that("Good names for dummies with reocurring patterns", { + set.seed(1) # 200 all but guarantees (99.999% chance) 1:15 all represented, #1350 data = data.frame( matrix(