1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
#' Select variables using dplyr
#'
#' `step_select()` creates a *specification* of a recipe step
#' that will select variables using [dplyr::select()].
#'
#' @inheritParams step_center
#' @param role For model terms selected by this step, what analysis
#' role should they be assigned?
#' @template step-return
#' @details When an object in the user's global environment is
#' referenced in the expression defining the new variable(s),
#' it is a good idea to use quasiquotation (e.g. `!!`) to embed
#' the value of the object in the expression (to be portable
#' between sessions). See the examples.
#'
#' # Tidying
#'
#' When you [`tidy()`][tidy.recipe()] this step, a tibble with column
#' `terms` which contains the `select` expressions as character strings
#' (and are not reparsable) is returned.
#'
#' @template case-weights-not-supported
#'
#' @family variable filter steps
#' @family dplyr steps
#' @template filter-steps
#' @export
#' @examples
#' library(dplyr)
#'
#' iris_tbl <- as_tibble(iris)
#' iris_train <- slice(iris_tbl, 1:75)
#' iris_test <- slice(iris_tbl, 76:150)
#'
#' dplyr_train <- select(iris_train, Species, starts_with("Sepal"))
#' dplyr_test <- select(iris_test, Species, starts_with("Sepal"))
#'
#' rec <- recipe(~., data = iris_train) %>%
#' step_select(Species, starts_with("Sepal")) %>%
#' prep(training = iris_train)
#'
#' rec_train <- bake(rec, new_data = NULL)
#' all.equal(dplyr_train, rec_train)
#'
#' rec_test <- bake(rec, iris_test)
#' all.equal(dplyr_test, rec_test)
#'
#' # Local variables
#' sepal_vars <- c("Sepal.Width", "Sepal.Length")
#'
#' qq_rec <-
#' recipe(~., data = iris_train) %>%
#' # fine for interactive usage
#' step_select(Species, all_of(sepal_vars)) %>%
#' # best approach for saving a recipe to disk
#' step_select(Species, all_of(!!sepal_vars))
#'
#' # Note that `sepal_vars` is inlined in the second approach
#' qq_rec
step_select <- function(recipe,
...,
role = NA,
trained = FALSE,
skip = FALSE,
id = rand_id("select")) {
add_step(
recipe,
step_select_new(
terms = enquos(...),
trained = trained,
role = role,
skip = skip,
id = id
)
)
}
step_select_new <- function(terms, role, trained, skip, id) {
step(
subclass = "select",
terms = terms,
role = role,
trained = trained,
skip = skip,
id = id
)
}
#' @export
prep.step_select <- function(x, training, info = NULL, ...) {
terms <- recipes_eval_select(x$terms, training, info, allow_rename = TRUE)
step_select_new(
terms = terms,
trained = TRUE,
role = x$role,
skip = x$skip,
id = x$id
)
}
#' @export
bake.step_select <- function(object, new_data, ...) {
check_new_data(object$terms, object, new_data)
dplyr::select(new_data, dplyr::all_of(object$terms))
}
print.step_select <-
function(x, width = max(20, options()$width - 35), ...) {
title <- "Variables selected "
print_step(names(x$terms), x$terms, x$trained, title, width)
invisible(x)
}
#' @rdname tidy.recipe
#' @export
tidy.step_select <- function(x, ...) {
if (is_trained(x)) {
res <- tibble(terms = names(x$terms))
} else {
var_expr <- map(x$terms, quo_get_expr)
var_expr <- map_chr(var_expr, quo_text, width = options()$width, nlines = 1)
res <- tibble(terms = unname(var_expr))
}
res$id <- x$id
res
}
|
