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
|
#' @importFrom magrittr %>%
#' @export
magrittr::`%>%`
null <- function(...) invisible()
escape_regex <- function(x) {
chars <- c("*", ".", "?", "^", "+", "$", "|", "(", ")", "[", "]", "{", "}", "\\")
gsub(paste0("([\\", paste0(collapse = "\\", chars), "])"), "\\\\\\1", x, perl = TRUE)
}
maybe_restart <- function(restart) {
if (!is.null(findRestart(restart))) {
invokeRestart(restart)
}
}
# Backport for R < 4.0
deparse1 <- function(expr, ...) paste(deparse(expr, ...), collapse = "\n")
can_entrace <- function(cnd) {
!inherits(cnd, "Throwable")
}
# Need to strip environment and source references to make lightweight
# function suitable to send to another process
transport_fun <- function(f) {
environment(f) <- .GlobalEnv
f <- zap_srcref(f)
f
}
isNA <- function(x) length(x) == 1 && is.na(x)
compact <- function(x) {
x[lengths(x) > 0]
}
# Handled specially in test_code so no backtrace
testthat_warn <- function(message, ...) {
warn(message, class = "testthat_warn", ...)
}
split_by_line <- function(x) {
trailing_nl <- grepl("\n$", x)
x <- strsplit(x, "\n")
x[trailing_nl] <- lapply(x[trailing_nl], c, "")
x
}
rstudio_tickle <- function() {
if (!is_installed("rstudioapi")) {
return()
}
if (!rstudioapi::hasFun("executeCommand")) {
return()
}
rstudioapi::executeCommand("vcsRefresh")
rstudioapi::executeCommand("refreshFiles")
}
first_upper <- function(x) {
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
in_rcmd_check <- function() {
nzchar(Sys.getenv("_R_CHECK_PACKAGE_NAME_", ""))
}
map_chr <- function(.x, .f, ...) {
.f <- as_function(.f)
vapply(.x, .f, FUN.VALUE = character(1), ...)
}
map_lgl <- function(.x, .f, ...) {
.f <- as_function(.f)
vapply(.x, .f, FUN.VALUE = logical(1), ...)
}
r_version <- function() paste0("R", getRversion()[, 1:2])
# Waiting on https://github.com/r-lib/withr/pull/188
local_tempfile1 <- function(lines, env = parent.frame()) {
path <- withr::local_tempfile(.local_envir = env)
writeLines(lines, path)
path
}
|
