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
|
validate_is <- function(.x, .f, .expected, .x_nm, .note = "") {
if (is_missing(.x_nm)) {
.x_nm <- as_label(enexpr(.x))
}
ok <- .f(.x)
if (!ok) {
if (!identical(.note, "")) {
.note <- glue::glue(" (", .note, ")")
}
.actual <- class1(.x)
glubort(
"{.x_nm} should be a {.expected}{.note}, ",
"not a {.actual}."
)
}
invisible(.x)
}
validate_has_unique_names <- function(x, x_nm) {
if (!has_unique_names(x)) {
glubort(
"All elements of `{x_nm}` must have unique names."
)
}
invisible(x)
}
validate_has_unique_column_names <- function(x, x_nm) {
if (!has_unique_column_names(x)) {
glubort(
"All columns of `{x_nm}` must have unique names."
)
}
invisible(x)
}
validate_recipes_available <- function() {
if (!requireNamespace("recipes", quietly = TRUE)) {
abort(
"The `recipes` package must be available to use the recipe interface."
)
}
invisible()
}
# the formula must have an implicit intercept to remove
# dont let the user do `0+` or `+0` or `-1`
validate_formula_has_intercept <- function(formula) {
formula <- f_rhs(formula)
validate_not_1_or_0(formula)
recurse_intercept_search(formula)
}
validate_not_1_or_0 <- function(formula) {
if (!is_scalar_integerish(formula)) {
return(invisible(formula))
}
if (formula == 1) {
glubort(
"`formula` must not contain the intercept term, `1`."
)
}
if (formula == 0) {
glubort(
"`formula` must not contain the intercept removal term, `0`."
)
}
invisible(formula)
}
recurse_intercept_search <- function(x) {
if (!is_call(x)) {
return(invisible(x))
}
cll_fn <- call_fn(x)
cll_args <- call_args(x)
# Check for `+ 0` or `0 +`
if (identical(cll_fn, `+`)) {
for (arg in cll_args) {
if (arg == 0L) {
abort(
"`formula` must not contain the intercept removal term: `+ 0` or `0 +`."
)
}
}
}
# Check for `- 1`
if (identical(cll_fn, `-`)) {
if (length(cll_args) == 2L) {
arg <- cll_args[[2]]
}
if (length(cll_args) == 1L) {
arg <- cll_args[[1]]
}
if (arg == 1L) {
abort("`formula` must not contain the intercept removal term: `- 1`.")
}
}
# Recurse
for (arg in cll_args) {
recurse_intercept_search(arg)
}
invisible(x)
}
|
