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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#' Impute Numeric Data Using the Mean
#'
#' `step_meanimpute` creates a *specification* of a recipe step that will
#' substitute missing values of numeric variables by the training set mean of
#' those variables.
#'
#' @inheritParams step_center
#' @param ... One or more selector functions to choose which variables are
#' affected by the step. See [selections()] for more details. For the `tidy`
#' method, these are not currently used.
#' @param role Not used by this step since no new variables are created.
#' @param means A named numeric vector of means. This is `NULL` until computed
#' by [prep.recipe()]. Note that, if the original data are integers, the mean
#' will be converted to an integer to maintain the same data type.
#' @param trim The fraction (0 to 0.5) of observations to be trimmed from each
#' end of the variables before the mean is computed. Values of trim outside
#' that range are taken as the nearest endpoint.
#' @return An updated version of `recipe` with the new step added to the
#' sequence of existing steps (if any). For the `tidy` method, a tibble with
#' columns `terms` (the selectors or variables selected) and `model` (the mean
#' value).
#' @keywords datagen
#' @concept preprocessing
#' @concept imputation
#' @export
#' @details `step_meanimpute` estimates the variable means from the data used
#' in the `training` argument of `prep.recipe`. `bake.recipe` then applies the
#' new values to new data sets using these averages.
#' @examples
#' library(modeldata)
#' data("credit_data")
#'
#' ## missing data per column
#' vapply(credit_data, function(x) mean(is.na(x)), c(num = 0))
#'
#' set.seed(342)
#' in_training <- sample(1:nrow(credit_data), 2000)
#'
#' credit_tr <- credit_data[ in_training, ]
#' credit_te <- credit_data[-in_training, ]
#' missing_examples <- c(14, 394, 565)
#'
#' rec <- recipe(Price ~ ., data = credit_tr)
#'
#' impute_rec <- rec %>%
#' step_meanimpute(Income, Assets, Debt)
#'
#' imp_models <- prep(impute_rec, training = credit_tr)
#'
#' imputed_te <- bake(imp_models, new_data = credit_te, everything())
#'
#' credit_te[missing_examples,]
#' imputed_te[missing_examples, names(credit_te)]
#'
#' tidy(impute_rec, number = 1)
#' tidy(imp_models, number = 1)
step_meanimpute <-
function(recipe,
...,
role = NA,
trained = FALSE,
means = NULL,
trim = 0,
skip = FALSE,
id = rand_id("meanimpute")) {
add_step(
recipe,
step_meanimpute_new(
terms = ellipse_check(...),
role = role,
trained = trained,
means = means,
trim = trim,
skip = skip,
id = id
)
)
}
step_meanimpute_new <-
function(terms, role, trained, means, trim, skip, id) {
step(
subclass = "meanimpute",
terms = terms,
role = role,
trained = trained,
means = means,
trim = trim,
skip = skip,
id = id
)
}
#' @export
prep.step_meanimpute <- function(x, training, info = NULL, ...) {
col_names <- eval_select_recipes(x$terms, training, info)
check_type(training[, col_names])
means <- lapply(training[, col_names], mean, trim = x$trim, na.rm = TRUE)
means <- purrr::map2(means, training[, col_names], cast)
step_meanimpute_new(
terms = x$terms,
role = x$role,
trained = TRUE,
means,
trim = x$trim,
skip = x$skip,
id = x$id
)
}
#' @export
bake.step_meanimpute <- function(object, new_data, ...) {
for (i in names(object$means)) {
if (any(is.na(new_data[[i]])))
new_data[is.na(new_data[[i]]), i] <- object$means[[i]]
}
as_tibble(new_data)
}
print.step_meanimpute <-
function(x, width = max(20, options()$width - 30), ...) {
cat("Mean Imputation for ", sep = "")
printer(names(x$means), x$terms, x$trained, width = width)
invisible(x)
}
#' @rdname step_meanimpute
#' @param x A `step_meanimpute` object.
#' @export
tidy.step_meanimpute <- function(x, ...) {
if (is_trained(x)) {
res <- tibble(terms = names(x$means),
model = unlist(x$means))
} else {
term_names <- sel2char(x$terms)
res <- tibble(terms = term_names, model = na_dbl)
}
res$id <- x$id
res
}
#' @rdname tunable.step
#' @export
tunable.step_meanimpute <- function(x, ...) {
tibble::tibble(
name = "trim",
call_info = list(
list(pkg = "dials", fun = "trim_amount")
),
source = "recipe",
component = "step_meanimpute",
component_id = x$id
)
}
|
