jmbarbone

#' 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")

jmbarbone

# 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 "),

jmbarbone

vendor <- function() {
  ns <- asNamespace("fuj")
  writeLines(
    unlist(sapply(
      ls(ns),
      function(x) {
        format(call("assign", x, get(x, ns)))
      }
    )), 
    "R/fuj.R"

jmbarbone

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)]
}

jmbarbone

#' 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`,
#'

jmbarbone

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()) {

jmbarbone

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)

jmbarbone

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
  

jmbarbone

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(

jmbarbone

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")]
}