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
|
#' Mutate multiple columns using dplyr
#'
#' `step_mutate_at` creates a *specification* of a recipe step that will modify
#' the selected variables using a common function via [dplyr::mutate_at()].
#'
#' @inheritParams step_pca
#' @inheritParams step_center
#' @param fn A function fun, a quosure style lambda `~ fun(.)`` or a list of
#' either form. (see [dplyr::mutate_at()]). **Note that this argument must be
#' named**.
#' @param inputs A vector of column names populated by [prep()].
#' @template step-return
#' @template mutate-leakage
#' @details
#'
#' # Tidying
#'
#' When you [`tidy()`][tidy.recipe()] this step, a tibble with column
#' `terms` which contains the columns being transformed is returned.
#'
#' @template case-weights-not-supported
#'
#' @family multivariate transformation steps
#' @family dplyr steps
#' @export
#' @examples
#' library(dplyr)
#' recipe(~., data = iris) %>%
#' step_mutate_at(contains("Length"), fn = ~ 1 / .) %>%
#' prep() %>%
#' bake(new_data = NULL) %>%
#' slice(1:10)
#'
#' recipe(~., data = iris) %>%
#' # leads to more columns being created.
#' step_mutate_at(contains("Length"), fn = list(log = log, sqrt = sqrt)) %>%
#' prep() %>%
#' bake(new_data = NULL) %>%
#' slice(1:10)
#' @export
step_mutate_at <- function(recipe, ...,
fn,
role = "predictor",
trained = FALSE,
inputs = NULL,
skip = FALSE,
id = rand_id("mutate_at")) {
add_step(
recipe,
step_mutate_at_new(
terms = enquos(...),
fn = fn,
trained = trained,
role = role,
inputs = inputs,
skip = skip,
id = id
)
)
}
step_mutate_at_new <-
function(terms, fn, role, trained, inputs, skip, id) {
step(
subclass = "mutate_at",
terms = terms,
fn = fn,
role = role,
trained = trained,
inputs = inputs,
skip = skip,
id = id
)
}
#' @export
prep.step_mutate_at <- function(x, training, info = NULL, ...) {
col_names <- recipes_eval_select(x$terms, training, info)
step_mutate_at_new(
terms = x$terms,
fn = x$fn,
trained = TRUE,
role = x$role,
inputs = col_names,
skip = x$skip,
id = x$id
)
}
#' @export
bake.step_mutate_at <- function(object, new_data, ...) {
dplyr::mutate_at(new_data, .vars = object$inputs, .funs = object$fn)
}
print.step_mutate_at <-
function(x, width = max(20, options()$width - 35), ...) {
title <- "Variable mutation for "
print_step(x$inputs, x$terms, x$trained, title, width)
invisible(x)
}
#' @rdname tidy.recipe
#' @export
tidy.step_mutate_at <- function(x, ...) {
if (is_trained(x)) {
res <- tibble(terms = unname(x$inputs))
} else {
term_names <- sel2char(x$terms)
res <- tibble(terms = term_names)
}
res$id <- x$id
res
}
|
