1library(testthat)
2library(recipes)
3library(lubridate)
4library(tibble)
5
6
7examples <- data.frame(Dan = ymd("2002-03-04") + days(1:10),
8                       Stefan = ymd("2006-01-13") + days(1:10))
9
10examples$Dan <- as.POSIXct(examples$Dan)
11
12date_rec <- recipe(~ Dan + Stefan, examples) %>%
13  step_date(all_predictors())
14
15feats <- c("year", "doy", "week", "decimal", "semester", "quarter", "dow", "month")
16
17test_that('default option', {
18  # because of https://github.com/tidyverse/lubridate/issues/928
19  skip_if(utils::packageVersion("lubridate") <= "1.7.9.9000")
20
21  date_rec <- recipe(~ Dan + Stefan, examples) %>%
22    step_date(all_predictors(), features = feats)
23
24  date_rec <- prep(date_rec, training = examples)
25  date_res <- bake(date_rec, new_data = examples)
26
27  date_exp <- tibble(
28    Dan = examples$Dan,
29    Stefan = examples$Stefan,
30    Dan_year = year(examples$Dan),
31    Dan_doy = yday(examples$Dan),
32    Dan_week = week(examples$Dan),
33    Dan_decimal = decimal_date(examples$Dan),
34    Dan_semester = semester(examples$Dan),
35    Dan_quarter = quarter(examples$Dan),
36    Dan_dow = wday(examples$Dan, label = TRUE, abbr = TRUE),
37    Dan_month = month(examples$Dan, label = TRUE, abbr = TRUE),
38    Stefan_year = year(examples$Stefan),
39    Stefan_doy = yday(examples$Stefan),
40    Stefan_week = week(examples$Stefan),
41    Stefan_decimal = decimal_date(examples$Stefan),
42    Stefan_semester = semester(examples$Stefan),
43    Stefan_quarter = quarter(examples$Stefan),
44    Stefan_dow = wday(examples$Stefan, label = TRUE, abbr = TRUE),
45    Stefan_month = month(examples$Stefan, label = TRUE, abbr = TRUE)
46  )
47  date_exp$Dan_dow <- factor(as.character(date_exp$Dan_dow), levels = levels(date_exp$Dan_dow))
48  date_exp$Dan_month <- factor(as.character(date_exp$Dan_month), levels = levels(date_exp$Dan_month))
49  date_exp$Stefan_dow <- factor(as.character(date_exp$Stefan_dow), levels = levels(date_exp$Stefan_dow))
50  date_exp$Stefan_month <- factor(as.character(date_exp$Stefan_month), levels = levels(date_exp$Stefan_month))
51
52  expect_equal(date_res, date_exp)
53})
54
55
56test_that('nondefault options', {
57  # because of https://github.com/tidyverse/lubridate/issues/928
58  skip_if(utils::packageVersion("lubridate") <= "1.7.9.9000")
59
60  date_rec <- recipe(~ Dan + Stefan, examples) %>%
61    step_date(all_predictors(), features = c("dow", "month"), label = FALSE)
62
63  date_rec <- prep(date_rec, training = examples)
64  date_res <- bake(date_rec, new_data = examples)
65
66  date_exp <- tibble(
67    Dan = examples$Dan,
68    Stefan = examples$Stefan,
69    Dan_dow = wday(examples$Dan, label = FALSE),
70    Dan_month = month(examples$Dan, label = FALSE),
71    Stefan_dow = wday(examples$Stefan, label = FALSE),
72    Stefan_month = month(examples$Stefan, label = FALSE)
73  )
74
75  expect_equal(date_res, date_exp)
76})
77
78
79test_that('ordinal values', {
80  # because of https://github.com/tidyverse/lubridate/issues/928
81  skip_if(utils::packageVersion("lubridate") <= "1.7.9.9000")
82
83  date_rec <- recipe(~ Dan + Stefan, examples) %>%
84    step_date(all_predictors(), features = c("dow", "month"), ordinal = TRUE)
85
86  date_rec <- prep(date_rec, training = examples)
87  date_res <- bake(date_rec, new_data = examples)
88
89  date_exp <- tibble(
90    Dan = examples$Dan,
91    Stefan = examples$Stefan,
92    Dan_dow = wday(examples$Dan, label = TRUE),
93    Dan_month = month(examples$Dan, label = TRUE),
94    Stefan_dow = wday(examples$Stefan, label = TRUE),
95    Stefan_month = month(examples$Stefan, label = TRUE)
96  )
97
98  expect_equal(date_res, date_exp)
99})
100
101
102test_that('printing', {
103  # because of https://github.com/tidyverse/lubridate/issues/928
104  skip_if(utils::packageVersion("lubridate") <= "1.7.9.9000")
105
106  date_rec <- recipe(~ Dan + Stefan, examples) %>%
107    step_date(all_predictors(), features = feats)
108  expect_output(print(date_rec))
109  expect_output(prep(date_rec, training = examples, verbose = TRUE))
110})
111
112test_that('keep_original_cols works', {
113  date_rec <- recipe(~ Dan + Stefan, examples) %>%
114    step_date(all_predictors(), features = feats, keep_original_cols = FALSE)
115
116  date_rec <- prep(date_rec, training = examples)
117  date_res <- bake(date_rec, new_data = examples)
118
119  expect_equal(
120    colnames(date_res),
121    c(paste0("Dan_", feats), paste0("Stefan_", feats))
122  )
123})
124
125test_that('can prep recipes with no keep_original_cols', {
126  date_rec <- recipe(~ Dan + Stefan, examples) %>%
127    step_date(all_predictors(), features = feats, keep_original_cols = FALSE)
128
129  date_rec$steps[[1]]$keep_original_cols <- NULL
130
131  expect_warning(
132    date_rec <- prep(date_rec, training = examples, verbose = FALSE),
133    "'keep_original_cols' was added to"
134  )
135
136  expect_error(
137    date_res <- bake(date_rec, new_data = examples, all_predictors()),
138    NA
139  )
140})
141
142