1library(testthat) 2library(recipes) 3library(dplyr) 4 5# ------------------------------------------------------------------------------ 6 7iris_rec <- recipe( ~ ., data = iris) 8 9# ------------------------------------------------------------------------------ 10 11test_that('basic usage', { 12 rec <- 13 iris_rec %>% 14 step_mutate( 15 dbl_width = Sepal.Width * 2, 16 half_length = Sepal.Length / 2 17 ) 18 19 prepped <- prep(rec, training = iris %>% slice(1:75)) 20 21 dplyr_train <- 22 iris %>% 23 as_tibble() %>% 24 slice(1:75) %>% 25 mutate( 26 dbl_width = Sepal.Width * 2, 27 half_length = Sepal.Length / 2 28 ) 29 30 rec_train <- juice(prepped) 31 expect_equal(dplyr_train, rec_train) 32 33 dplyr_test <- 34 iris %>% 35 as_tibble() %>% 36 slice(76:150) %>% 37 mutate( 38 dbl_width = Sepal.Width * 2, 39 half_length = Sepal.Length / 2 40 ) 41 rec_test <- bake(prepped, iris %>% slice(76:150)) 42 expect_equal(dplyr_test, rec_test) 43}) 44 45test_that('quasiquotation', { 46 const <- 9.077 47 rec_1 <- 48 iris_rec %>% 49 step_mutate(new_var = Sepal.Width * const) 50 51 prepped_1 <- prep(rec_1, training = iris %>% slice(1:75)) 52 53 dplyr_train <- 54 iris %>% 55 as_tibble() %>% 56 slice(1:75) %>% 57 mutate(new_var = Sepal.Width * const) 58 59 rec_1_train <- juice(prepped_1) 60 expect_equal(dplyr_train, rec_1_train) 61 62 rec_2 <- 63 iris_rec %>% 64 step_mutate(new_var = Sepal.Width * !!const) 65 66 prepped_2 <- prep(rec_2, training = iris %>% slice(1:75)) 67 68 rm(const) 69 expect_error(prep(rec_1, training = iris %>% slice(1:75))) 70 expect_error( 71 prepped_2 <- prep(rec_2, training = iris %>% slice(1:75)), 72 regexp = NA 73 ) 74 rec_2_train <- juice(prepped_2) 75 expect_equal(dplyr_train, rec_2_train) 76}) 77 78test_that("can use unnamed expressions like `across()` (#759)", { 79 skip_if_not_installed("dplyr", "1.0.0") 80 81 df <- tibble( 82 x = c(TRUE, FALSE), 83 y = c(1, 2), 84 z = c(TRUE, FALSE) 85 ) 86 87 rec <- recipe(~., df) %>% 88 step_mutate(across(where(is.logical), as.integer)) 89 90 rec <- prep(rec, df) 91 92 expect_identical( 93 bake(rec, new_data = NULL), 94 mutate(df, across(where(is.logical), as.integer)) 95 ) 96}) 97 98test_that('no input', { 99 no_inputs <- 100 iris_rec %>% 101 step_mutate() %>% 102 prep(training = iris) %>% 103 juice(composition = "data.frame") 104 expect_equal(no_inputs, iris) 105}) 106 107test_that('printing', { 108 rec <- iris_rec %>% step_mutate(x = 5) 109 expect_output(print(rec)) 110 expect_output(prep(rec, training = iris, verbose = TRUE)) 111}) 112 113test_that("tidying allows for named and unnamed expressions", { 114 rec <- step_mutate(iris_rec, x = mean(y), id = "named") 115 tidied <- tidy(rec, id = "named") 116 117 # Named expressions use the name 118 expect_identical(tidied$terms, "x") 119 expect_identical(tidied$value, "mean(y)") 120 121 rec <- step_mutate(iris_rec, across(c(x, y), mean), id = "unnamed") 122 tidied <- tidy(rec, id = "unnamed") 123 124 # Unnamed expressions use the expression 125 expect_identical(tidied$terms, "across(c(x, y), mean)") 126 expect_identical(tidied$value, "across(c(x, y), mean)") 127}) 128 129# ------------------------------------------------------------------------------ 130 131test_that('basic usage', { 132 rec <- 133 iris_rec %>% 134 step_mutate_at(contains("Length"), fn = log) 135 136 prepped <- prep(rec, training = iris %>% slice(1:75)) 137 138 dplyr_train <- 139 iris %>% 140 as_tibble() %>% 141 slice(1:75) %>% 142 mutate( 143 Sepal.Length = log(Sepal.Length), 144 Petal.Length = log(Petal.Length) 145 ) 146 147 rec_train <- juice(prepped) 148 expect_equal(dplyr_train, rec_train) 149 150 dplyr_test <- 151 iris %>% 152 as_tibble() %>% 153 slice(76:150) %>% 154 mutate( 155 Sepal.Length = log(Sepal.Length), 156 Petal.Length = log(Petal.Length) 157 ) 158 rec_test <- bake(prepped, iris %>% slice(76:150)) 159 expect_equal(dplyr_test, rec_test) 160}) 161 162test_that('mulitple functions', { 163 rec <- 164 iris_rec %>% 165 step_mutate_at(contains("Length"), fn = list(a = log, b = sqrt)) 166 167 prepped <- prep(rec, training = iris %>% slice(1:75)) 168 169 dplyr_train <- 170 iris %>% 171 as_tibble() %>% 172 slice(1:75) %>% 173 mutate( 174 Sepal.Length_a = log(Sepal.Length), 175 Petal.Length_a = log(Petal.Length), 176 Sepal.Length_b = sqrt(Sepal.Length), 177 Petal.Length_b = sqrt(Petal.Length) 178 ) 179 180 rec_train <- juice(prepped) 181 expect_equal(dplyr_train, rec_train) 182 183 dplyr_test <- 184 iris %>% 185 as_tibble() %>% 186 slice(76:150) %>% 187 mutate( 188 Sepal.Length_a = log(Sepal.Length), 189 Petal.Length_a = log(Petal.Length), 190 Sepal.Length_b = sqrt(Sepal.Length), 191 Petal.Length_b = sqrt(Petal.Length) 192 ) 193 rec_test <- bake(prepped, iris %>% slice(76:150)) 194 expect_equal(dplyr_test, rec_test) 195}) 196 197 198test_that('no input', { 199 expect_error( 200 iris_rec %>% 201 step_mutate_at() %>% 202 prep(training = iris) %>% 203 juice(composition = "data.frame") 204 ) 205}) 206 207test_that('printing', { 208 rec <- iris_rec %>% step_mutate_at(contains("Sepal"), fn = log) 209 expect_output(print(rec)) 210 expect_output(prep(rec, training = iris, verbose = TRUE)) 211}) 212