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