From 2d7daa78ca50db34942f181b1c0877f7a6132c19 Mon Sep 17 00:00:00 2001
From: Anatoliy Sokolov <ansokolov@dow.com>
Date: Thu, 15 Aug 2024 14:20:24 -0400
Subject: [PATCH] Updating superseded map_dfr to map %>% list_rbind. Fixes
 #115.

---
 R/plot_race.R                                  | 3 ++-
 R/sim_anneal_helpers.R                         | 5 +++--
 tests/testthat/test-race-s3.R                  | 6 +++---
 tests/testthat/test-random-integer-neighbors.R | 5 +++--
 tests/testthat/test-sa-perturb.R               | 5 +++--
 5 files changed, 14 insertions(+), 10 deletions(-)

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")