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
|
#' @param formula Either `NULL`, or a formula that specifies how the
#' predictors and outcomes should be preprocessed. This argument is set
#' automatically at [mold()] time.
#'
#' @param indicators A single character string. Control how factors are
#' expanded into dummy variable indicator columns. One of:
#'
#' - `"traditional"` - The default. Create dummy variables using the
#' traditional [model.matrix()] infrastructure. Generally this creates
#' `K - 1` indicator columns for each factor, where `K` is the number of
#' levels in that factor.
#'
#' - `"none"` - Leave factor variables alone. No expansion is done.
#'
#' - `"one_hot"` - Create dummy variables using a one-hot encoding approach
#' that expands unordered factors into all `K` indicator columns, rather than
#' `K - 1`.
#'
#' @rdname new-blueprint
#' @export
new_formula_blueprint <- function(intercept = FALSE,
allow_novel_levels = FALSE,
ptypes = NULL,
formula = NULL,
indicators = "traditional",
composition = "tibble",
...,
subclass = character()) {
validate_is_formula_or_null(formula)
indicators <- validate_indicators(indicators)
new_blueprint(
intercept = intercept,
allow_novel_levels = allow_novel_levels,
ptypes = ptypes,
formula = formula,
indicators = indicators,
composition = composition,
...,
subclass = c(subclass, "formula_blueprint")
)
}
#' @export
refresh_blueprint.formula_blueprint <- function(blueprint) {
do.call(new_formula_blueprint, as.list(blueprint))
}
is_formula_blueprint <- function(x) {
inherits(x, "formula_blueprint")
}
validate_is_formula_blueprint <- function(blueprint) {
validate_is(blueprint, is_formula_blueprint, "formula_blueprint")
}
# ------------------------------------------------------------------------------
validate_is_formula_or_null <- function(formula) {
validate_is_or_null(formula, is_formula, "formula")
}
# ------------------------------------------------------------------------------
validate_indicators <- function(indicators) {
validate_is_character(indicators, "indicators")
n_indicators <- length(indicators)
if (n_indicators != 1L) {
glubort("`indicators` must have size 1, not {n_indicators}.")
}
arg_match(indicators, c("traditional", "none", "one_hot"))
}
|
