File: mutate_at.R

package info (click to toggle)
r-cran-recipes 0.1.15%2Bdfsg-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 2,496 kB
  • sloc: sh: 37; makefile: 2
file content (115 lines) | stat: -rw-r--r-- 2,928 bytes parent folder | download
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
#'
#' `step_mutate_at` creates a *specification* of a recipe step that will modify
#' the selected variables using a common function.
#'
#' @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 role For model terms created by this step, what analysis role should
#'  they be assigned? By default, the function assumes that the new dimension
#'  columns created by the original variables will be used as predictors in a
#'  model.
#' @param inputs A vector of column names populated by `prep()`.
#' @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` which contains the columns being transformed.
#' @keywords datagen
#' @concept preprocessing
#' @concept transformation_methods
#' @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 = ellipse_check(...),
      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 <- eval_select_recipes(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), ...) {
    cat("Variable mutation for ", sep = "")
    printer(x$inputs, x$terms, x$trained, width = width)
    invisible(x)
  }

#' @rdname step_mutate
#' @export
tidy.step_mutate_at <- function(x, ...) {
  if (is_trained(x)) {
    res <- tibble(terms = x$inputs)
  } else {
    term_names <- sel2char(x$terms)
    res <- tibble(terms = term_names)
  }
  res$id <- x$id
  res
}