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