merge_list <- function(x, y, keep = c("right", "left")) {
keep <- match.arg(keep)
stopifnot(is.list(x), is.list(y))
x <- Filter(Negate(is.null), as.list(x))
y <- Filter(Negate(is.null), as.list(y))
c(x, y)[!duplicated(c(names(x), names(y)), fromLast = keep == "right")]
}
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| readr_write <- function(x, file, ..., .fun = "csv", .check = TRUE) { | |
| if (is.function(.fun)) { | |
| .fun <- match.fun(fun) | |
| } else { | |
| if (requireNamespace("readr", quietly = TRUE)) { | |
| .fun <- paste0("write_", .fun) | |
| .fun <- getFromNamespace(.fun, asNamespace("readr")) | |
| } else { | |
| .fun <- switch( |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| window_apply <- function(x, n = 1, fun = mean) { | |
| fun <- match.fun(fun) | |
| if (n == 0) { | |
| return(x) | |
| } | |
| s <- seq_along(x) | |
| lower <- s - n | |
| upper <- s + n | |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| dput_int_string <- function(x) { | |
| x <- sort(unique(as.integer(x))) | |
| d <- diff(x) == 1 | |
| if (length(x) == 1 || all(d)) { | |
| return(utils::capture.output(dput(x))) | |
| } | |
| d[!d] <- NA | |
| d <- c(d, NA) |
library(S7)
# problem -----------------------------------------------------------------
class_a <- new_class("class_a", properties = list(x = class_character))
class_b <- new_class(
"class_b",
properties = list(class_a = class_a),
constructor = function(class_a = class_a()) {
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #' Include exports | |
| #' | |
| #' Include (attach) a package and specific exports | |
| #' | |
| #' @description [include()] checks whether or not the namespace has been loaded | |
| #' to the [search()] path. It uses the naming convention `include:{package}` | |
| #' to denote the differences from loading via [library()] or [require()]. When | |
| #' `exports` is `NULL`, the environment is detached from the search path if | |
| #' found. When `exports` is not `NULL`, | |
| #' |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| largest_ns_object <- function(ns, mode = "any") { | |
| ns <- asNamespace(ns) | |
| sizes <- vapply( | |
| ls(ns, all.names = TRUE), | |
| \(x) utils::object.size(get0(x, ns, mode = mode)), | |
| NA_real_ | |
| ) | |
| sizes[which.max(sizes)] | |
| } |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| vendor <- function() { | |
| ns <- asNamespace("fuj") | |
| writeLines( | |
| unlist(sapply( | |
| ls(ns), | |
| function(x) { | |
| format(call("assign", x, get(x, ns))) | |
| } | |
| )), | |
| "R/fuj.R" |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # nolint start: object_usage_linter. | |
| sql_snakecase0 <- function(.data, new, old = new, na = "(missing)") { | |
| force(old) | |
| na <- as.character(na) | |
| dplyr::mutate( | |
| .data, | |
| !!rlang::sym(new) := tolower(!!rlang::sym(old)), | |
| !!rlang::sym(new) := REGEXP_REPLACE(!!rlang::sym(new), "\\%", "percent "), | |
| !!rlang::sym(new) := REGEXP_REPLACE(!!rlang::sym(new), "\\#", "n "), |
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| #' Evaluate an R6 object within its enclosed environment | |
| #' | |
| #' @param x An R6 object | |
| #' @param expr An expression to run | |
| #' @export | |
| #' @examples | |
| #' Foo <- R6::R6Class( | |
| #' "Foo", | |
| #' public = list( | |
| #' hello = function() cat("hello\n") |