-
Notifications
You must be signed in to change notification settings - Fork 2.1k
/
utils.r
104 lines (82 loc) · 1.87 KB
/
utils.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
97
98
99
100
101
102
103
104
#' @importFrom magrittr %>%
#' @export
magrittr::`%>%`
dots <- function(...) {
eval_bare(substitute(alist(...)))
}
deparse_trunc <- function(x, width = getOption("width")) {
text <- deparse(x, width.cutoff = width)
if (length(text) == 1 && nchar(text) < width) return(text)
paste0(substr(text[1], 1, width - 3), "...")
}
any_apply <- function(xs, f) {
for (x in xs) {
if (f(x)) return(TRUE)
}
FALSE
}
deparse_names <- function(x) {
x <- map_if(x, is_quosure, quo_squash)
x <- map_if(x, is_bare_formula, f_rhs)
map_chr(x, deparse)
}
commas <- function(...) paste0(..., collapse = ", ")
in_travis <- function() identical(Sys.getenv("TRAVIS"), "true")
named <- function(...) {
x <- c(...)
missing_names <- names2(x) == ""
names(x)[missing_names] <- x[missing_names]
x
}
unique_name <- local({
i <- 0
function() {
i <<- i + 1
paste0("zzz", i)
}
})
succeeds <- function(x, quiet = FALSE) {
tryCatch( #
{
x
TRUE
},
error = function(e) {
if (!quiet) {
inform(paste0("Error: ", e$message))
}
FALSE
}
)
}
is_1d <- function(x) {
# dimension check is for matrices and data.frames
(is_atomic(x) || is.list(x)) && length(dim(x)) <= 1
}
random_table_name <- function(n = 10) {
paste0(sample(letters, n, replace = TRUE), collapse = "")
}
attr_equal <- function(x, y) {
attr_x <- attributes(x)
if (!is.null(attr_x)) {
attr_x <- attr_x[sort(names(attr_x))]
}
attr_y <- attributes(y)
if (!is.null(attr_y)) {
attr_y <- attr_y[sort(names(attr_y))]
}
isTRUE(all.equal(attr_x, attr_y))
}
unstructure <- function(x) {
attributes(x) <- NULL
x
}
compact_null <- function(x) {
Filter(function(elt) !is.null(elt), x)
}
paste_line <- function(...) {
paste(chr(...), collapse = "\n")
}
abort_if_not <- function(...) {
tryCatch(stopifnot(...), simpleError = function(e) abort(e))
}