internal_f <- function(p, f) {
stopifnot(is.character(p), length(p) == 1)
stopifnot(is.character(f), length(f) == 1)
get(f, envir = asNamespace(p))
}
"%||%" <- function(a, b) {
if (length(a) > 0) a else b
}
subs <- matrix(ncol = 2, byrow = T, c(
# Common special function names
'[<-', 'subset',
'[', 'sub',
'<-', 'set',
# Infix verbs
'!', 'not',
'&', 'and',
'|', 'or',
'*', 'times',
'+', 'plus',
'^', 'pow',
# Others
'"', 'quote',
'#', 'hash',
'$', 'cash',
'%', 'grapes',
"'", 'single-quote',
'(', 'open-paren',
')', 'close-paren',
':', 'colon',
';', 'semi-colon',
'<', 'less-than',
'==', 'equals',
'=', 'equals',
'>', 'greater-than',
'?', 'help',
'@', 'at',
']', 'close-brace',
'\\', 'backslash',
'/', 'slash',
'`', 'tick',
'{', 'open-curly',
'}', 'close',
'~', 'twiddle'
))
subs[, 2] <- paste0("-", subs[, 2], "-")
nice_name <- function(x) {
x <- stringi::stri_replace_all_fixed(x, subs[, 1], subs[, 2],
vectorize_all = FALSE)
# Clean up any remaining
x <- str_replace_all(x, "[^A-Za-z0-9_.-]+", "-")
x <- str_replace_all(x, "-+", "-")
x <- str_replace_all(x, "^-|-$", "")
x
}
write_if_different <- function(path, contents, check = TRUE) {
if (!file.exists(dirname(path))) {
dir.create(dirname(path), showWarnings = FALSE)
}
if (check && !made_by_roxygen(path)) {
warning("The existing '", basename(path),
"' file was not generated by roxydoxy, and will not be overwritten.",
call. = FALSE, immediate. = TRUE)
return(FALSE)
}
if (same_contents(path, contents)) return(FALSE)
name <- basename(path)
if (!str_detect(name, "^[a-zA-Z][a-zA-Z0-9_.-]*$")) {
cat("Skipping invalid path: ", name, "\n")
FALSE
} else {
cat(sprintf('Writing %s\n', name))
writeLines(contents, path, useBytes = TRUE)
TRUE
}
}
same_contents <- function(path, contents) {
if (!file.exists(path)) return(FALSE)
contents <- paste0(paste0(contents, collapse = "\n"), "\n")
if (.Platform$OS.type == "windows") {
contents <- gsub("\n", "\r\n", contents, fixed = TRUE)
}
text_hash <- digest::digest(contents, serialize = FALSE)
file_hash <- digest::digest(file = path)
identical(text_hash, file_hash)
}
r_files <- function(path) {
sort_c(dir(file.path(path, "R"), "[.Rr]$", full.names = TRUE))
}
ignore_files <- function(rfiles, path) {
rbuildignore <- file.path(path, ".Rbuildignore")
if (!file.exists(rbuildignore))
return(rfiles)
# Strip leading directory and slashes
rfiles_relative <- sub(normalizePath(path, winslash = "/"), "", normalizePath(rfiles, winslash = "/"), fixed = TRUE)
rfiles_relative <- sub("^[/]*", "", rfiles_relative)
# Remove any files that match any perl-compatible regexp
patterns <- readLines(rbuildignore, warn = FALSE)
matches <- lapply(patterns, grepl, rfiles_relative, perl = TRUE)
matches <- Reduce("|", matches)
rfiles[!matches]
}
compact <- function(x) {
null <- vapply(x, is.null, logical(1))
x[!null]
}
block_warning <- function(block, ...) {
warning(
srcref_location(block$srcref), ": ", ...,
call. = FALSE,
immediate. = TRUE
)
NULL
}
srcref_location <- function(srcref = NULL) {
if (is.null(srcref)) return()
paste0(basename(srcref$filename), ":", srcref$lloc[1])
}
# Parse DESCRIPTION into convenient format
read.description <- function(file) {
dcf <- read.dcf(file, keep.white = "Authors@R")
dcf_list <- setNames(as.list(dcf[1, ]), colnames(dcf))
lapply(dcf_list, str_trim)
}
wrap_string <- function(x) UseMethod("wrap_string")
wrap_string.NULL <- function(x) return(x)
wrap_string.default <- function(x) {
y <- wrapString(x)
y <- gsub("\u{A0}", " ", y, useBytes = TRUE)
Encoding(y) <- "UTF-8"
class(y) <- class(x)
y
}
invert <- function(x) {
if (length(x) == 0) return()
stacked <- utils::stack(x)
tapply(as.character(stacked$ind), stacked$values, list)
}
has_colons <- function(x) {
grepl("::", x, fixed = TRUE)
}
# Collapse the values associated with duplicated keys
collapse <- function(key, value, fun, ...) {
stopifnot(is.character(key))
stopifnot(length(key) == length(value))
dedup <- tapply(value, key, fun, ..., simplify = FALSE)
# tapply orders alphabetically, so reorder to match original order
dedup <- dedup[unique(key)]
list(
key = names(dedup),
value = unname(dedup)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.