diff --git a/DESCRIPTION b/DESCRIPTION index 9316a8f..abc59dd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -26,7 +26,7 @@ Imports: dplyr (>= 1.1.1), ggplot2, parsnip (>= 1.1.0), - purrr, + purrr (>= 1.0.0), rlang, tibble, tidyr, diff --git a/R/plot_race.R b/R/plot_race.R index e73f324..2eb562f 100644 --- a/R/plot_race.R +++ b/R/plot_race.R @@ -27,7 +27,8 @@ plot_race <- function(x) { .order <- sort(unique(rs$.order)) - purrr::map_dfr(.order, ~ stage_results(.x, rs)) %>% + purrr::map(.order, ~ stage_results(.x, rs)) %>% + purrr::list_rbind() %>% ggplot2::ggplot(ggplot2::aes(x = stage, y = mean, group = .config, col = .config)) + ggplot2::geom_line(alpha = .5, show.legend = FALSE) + ggplot2::xlab("Analysis Stage") + diff --git a/R/sim_anneal_helpers.R b/R/sim_anneal_helpers.R index fe5b00a..e76d877 100644 --- a/R/sim_anneal_helpers.R +++ b/R/sim_anneal_helpers.R @@ -79,10 +79,11 @@ random_discrete_neighbor <- function(current, pset, prob, change) { random_integer_neighbor <- function(current, hist_values, pset, prob, change, retain = 1, tries = 500) { candidates <- - purrr::map_dfr( + purrr::map( 1:tries, ~ random_integer_neighbor_calc(current, pset, prob, change) - ) + ) %>% + purrr::list_rbind() rnd <- tune::encode_set(candidates, pset, as_matrix = TRUE) sample_by_distance(rnd, hist_values, retain = retain, pset = pset) diff --git a/tests/testthat/test-race-s3.R b/tests/testthat/test-race-s3.R index a18e51f..7ebc93e 100644 --- a/tests/testthat/test-race-s3.R +++ b/tests/testthat/test-race-s3.R @@ -35,7 +35,7 @@ test_that("racing S3 methods", { expect_equal(nrow(collect_metrics(anova_race, summarize = FALSE)), 2 * 20) expect_equal( nrow(collect_metrics(anova_race, summarize = FALSE, all_configs = TRUE)), - nrow(map_dfr(anova_race$.metrics, ~ .x)) + nrow(map(anova_race$.metrics, ~ .x) %>% list_rbind()) ) # ------------------------------------------------------------------------------ @@ -47,7 +47,7 @@ test_that("racing S3 methods", { ) expect_equal( nrow(collect_predictions(anova_race, all_configs = TRUE, summarize = TRUE)), - map_dfr(anova_race$.predictions, ~ .x) %>% distinct(.config, .row) %>% nrow() + map(anova_race$.predictions, ~ .x) %>% list_rbind() %>% distinct(.config, .row) %>% nrow() ) expect_equal( nrow(collect_predictions(anova_race, all_configs = FALSE, summarize = FALSE)), @@ -55,7 +55,7 @@ test_that("racing S3 methods", { ) expect_equal( nrow(collect_predictions(anova_race, all_configs = TRUE, summarize = FALSE)), - nrow(map_dfr(anova_race$.predictions, ~ .x)) + nrow(map(anova_race$.predictions, ~ .x) %>% list_rbind()) ) # ------------------------------------------------------------------------------ diff --git a/tests/testthat/test-random-integer-neighbors.R b/tests/testthat/test-random-integer-neighbors.R index 97a9e03..93c9284 100644 --- a/tests/testthat/test-random-integer-neighbors.R +++ b/tests/testthat/test-random-integer-neighbors.R @@ -3,13 +3,14 @@ test_that("random integers in range", { set.seed(123) parameters <- dials::parameters(list(dials::tree_depth(range = c(2, 3)))) random_integer_neigbors <- - purrr::map_dfr( + purrr::map( 1:500, ~ finetune:::random_integer_neighbor_calc( tibble::tibble(tree_depth = 3), parameters, 0.75, FALSE ) - ) + ) %>% + purrr::list_rbind() expect_true(all(random_integer_neigbors$tree_depth >= 2)) diff --git a/tests/testthat/test-sa-perturb.R b/tests/testthat/test-sa-perturb.R index 91fe8bc..834c510 100644 --- a/tests/testthat/test-sa-perturb.R +++ b/tests/testthat/test-sa-perturb.R @@ -49,10 +49,11 @@ test_that("categorical value switching", { vals <- tibble::tibble(activation = "relu", weight_func = "biweight") set.seed(1) new_vals <- - purrr::map_dfr( + purrr::map( 1:1000, ~ finetune:::random_discrete_neighbor(vals, cat_prm, prob = 1 / 4, change = FALSE) - ) + ) %>% + purrr::list_rbind() relu_same <- mean(new_vals$activation == "relu") biweight_same <- mean(new_vals$weight_func == "biweight")