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

jmbarbone

do.call(rbind, lapply(
  list(
    integer      = 1L,
    integerish   = 1.0,
    double       = 1.1,
    factor       = factor("a"),
    date_double  = structure(19486, class = "Date"),
    date_integer = structure(19486L, class = "Date"),
    time_double  = structure(1683663687, class = c("POSIXct", "POSIXt")),

jmbarbone

df <- palmerpenguins::penguins

bench::mark(
  rowwise = df |> 
    dplyr::rowwise() |> 
    dplyr::mutate(sum = sum(dplyr::c_across(c(bill_length_mm, bill_depth_mm, flipper_length_mm, body_mass_g)))) |> 
    dplyr::ungroup(),
  rowSums = df |> 

jmbarbone

fooReferenceClass <- setRefClass(
  "fooReferenceClass",
  fields = list(
    private = "environment",
    n = "integer"
  )
)

# create a list of values that will be transfered to private.  alternatively,

jmbarbone

do_call <- function(fun, ...) {
  fun <- match.fun(fun)
  forms <- as.list(formals(fun))
  params <- list(...)
  nms <- names(params)

  o <- order(match(nms, names(forms)))
  params <- params[o]
  nms <- nms[o]

jmbarbone

x <- c("apple", "banana", "orange", "pear", "grape")
p <- "[aeoiu][^(aeiou)]"

 regexpr(p, x) # integer vector
#> [1] 1 2 1 3 3
#> attr(,"match.length")
#> [1] 2 2 2 2 2
#> attr(,"index.type")
#> [1] "chars"
#> attr(,"useBytes")

jmbarbone

datarows <- function(...) {
  ls <- list(...)
  w <- which(vapply(ls, inherits, NA, "formula"))
  n <- length(w)
  cols <- as.character(ls[w])
  cols <- substr(cols, 2, nchar(cols))
  ls <- ls[-w]
  sa <- seq_along(ls)
  sa <- (sa - 1) %% n
  res <- lapply(split(ls, sa), unlist)