/
as-term.R
78 lines (68 loc) · 1.6 KB
/
as-term.R
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
#' Coerce to a Term Vector
#'
#' Coerces an R object to a [term-vector()].
#'
#' `as.term` has been `r lifecycle::badge("soft-deprecated")` for `as_term`.
#'
#' @inheritParams params
#'
#' @seealso [term-vector()] and [repair_terms()]
#' @export
#'
#' @examples
#' as_term(matrix(1:4, 2))
#' as_term(c("parm3[10]", "parm3[2]", "parm[2,2]", "parm[1,1]"))
as_term <- function(x, ...) UseMethod("as_term")
#' @rdname as_term
#' @export
as.term <- function(x, ...) {
out <- UseMethod("as.term")
deprecate_soft("0.2.0", "as.term()", "as_term()")
out
}
#' @export
as.term.default <- function(x, ..., from_as_term = FALSE) {
if(vld_false(from_as_term)) return(as_term(x, ...))
vec_cast(x, new_term())
}
#' @export
as_term.default <- function(x, ...) {
tryCatch(
vec_cast(x, new_term()),
error = function(e_cast) {
tryCatch(
as.term(x, ..., from_as_term = TRUE),
error = function(e) {
rlang::cnd_signal(e_cast)
}
)
}
)
}
#' @describeIn as_term Coerce character vector to term vector
#' @export
as_term.character <- function(x, repair = FALSE, normalize = repair, ...) {
chk_flag(repair)
chk_unused(...)
if (repair) {
x <- repair_terms_impl(x)
}
if(normalize) {
x <- normalize_terms_impl(x)
}
new_term(x)
}
#' @describeIn as_term Coerce numeric object to term vector
#' @export
as_term.numeric <- function(x, name = "par", ...) {
chk_string(name)
chk_unused(...)
term(!!name := dims(x))
}
#' @export
as_term.term <- function(x, ...) x
#' @export
as_term.term_rcrd <- function(x, ...) {
chk_unused(...)
vec_cast(x, new_term())
}