compact <- function(x) {
null <- vapply(x, is.null, logical(1))
x[!null]
}
sort_c <- function(x) with_collate("C", sort(x))
"%||%" <- function(a, b) if (length(a) == 0) b else a
modify_list <- function(a, b) {
if (is.null(a)) return(b)
if (is.null(b)) return(a)
modifyList(a, b)
}
#' @autoImports
write_if_different <- function(path, contents) {
if (!file.exists(dirname(path))) {
dir.create(dirname(path), showWarnings = 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)
TRUE
}
}
same_contents <- function(path, contents) {
if (!file.exists(path)) return(FALSE)
contents <- str_c(str_c(contents, collapse = "\n"), "\n")
text_hash <- digest(contents, serialize = FALSE)
file_hash <- digest(file = path)
identical(text_hash, file_hash)
}
invert <- function(x) {
stopifnot(is.list(x))
char <- vapply(x, is.character, logical(1))
stopifnot(all(char))
values <- unlist(x, use.names = FALSE)
ind <- rep.int(names(x), lapply(x, length))
split(ind, values)
}
is.syntactic <- function(x) make.names(x) == x
has.quotes <- function(x) str_detect(x, "'|\"")
quote_if_needed <- function(x) {
needs_quotes <- !has.quotes(x) & !is.syntactic(x)
x[needs_quotes] <- str_c('"', x[needs_quotes], '"')
x
}
#' @autoImports
str_truncate <- function(x, width = getOption("width")) {
lines <- str_split(x, "\n")[[1]]
n <- str_length(lines[1])
if (n <= width && length(lines) == 1) return(lines[1])
str_c(str_sub(lines[1], 1, width - 3), "...")
}
call_fun <- function(f, ...) f(...)
local_apropos <- function(x) {
grep(x, ls(topenv(environment())), ignore.case = FALSE, value = TRUE)
}
first_upper <- function(x) {
substr(x, 1, 1) <- toupper(substr(x, 1, 1))
x
}
first_lower <- function(x) {
substr(x, 1, 1) <- tolower(substr(x, 1, 1))
x
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.