-
Notifications
You must be signed in to change notification settings - Fork 1
/
dev.R
96 lines (88 loc) · 1.99 KB
/
dev.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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
#' add #' into each line of codes for roxygen examples
#'
#' @param x codes
#'
#' @return NULL
#' @export
#'
#' @examples
#'
#' roxygen_fmt(
#' "
#' code line1
#' code line2
#' "
#' )
#'
roxygen_fmt <- function(x) {
res <- str_split(x, "\\n")[[1]] %>%
str_c(collapse = "\n#' ")
cat(res)
}
#' use aliases for function arguments
#'
#' @param ... aliases of an argument
#' @param default a alias with a default value
#'
#' @return the finally value of this argument across all aliases
#' @export
#'
#' @examples
#'
#' # set y, z as aliases of x when create a function
#' func <- function(x = 1, y = NULL, z = NULL) {
#' x <- alias_arg(x, y, z, default = x)
#' return(x)
#' }
alias_arg <- function(..., default = NULL) {
default <- enquo(default)
aliases <- enexprs(...)
aliases_char <- as.character(aliases)
values <- list(...)
names(values) <- aliases_char
if (length(quo_name(default)) > 1) {
stop("should only have one default value!")
}
value_idx <- which(
purrr::map_lgl(values, ~ !is.null(.x)) &
(quo_name(default) != aliases_char)
)
if (length(value_idx) > 1) {
stop(
"please assign only one of ",
stringr::str_c(aliases_char, collapse = ",")
)
} else if (length(value_idx) == 1) {
return(values[[value_idx]])
} else if (length(value_idx) == 0) {
return(values[[quo_name(default)]])
}
}
#' check arguments by custom function
#'
#' @param ... arguments
#' @param n how many arguments should meet the custom conditions
#' @param fun custom conditions defined by a function
#'
#' @return logical value
#' @export
#'
#' @examples
#' x <- 1
#' y <- 3
#' z <- NULL
#'
#' func <- function(x = NULL, y = NULL, z = NULL) {
#' if (check_arg(x, y, z, n = 2)) {
#' print("As expected, two arguments is not NULL")
#' }
#'
#' if (check_arg(x, y, z, n = 1, method = ~ .x < 2)) {
#' print("As expected, one argument less than 2")
#' }
#' }
#'
check_arg <- function(..., n = 2, fun = not.null) {
res <- map_lgl(c(...), fun) %>% sum()
res == n
}