jmbarbone

#!/bin/sh
#
# Update a last commit date tag
#
# Finds the ""@Last commit date:"" tag and updates to current date
# Edited from: https://gist.github.com/johnjohndoe/4024222
d=`date '+%Y-%m-%d'`
# files=$(git diff-index --name-status --cached HEAD | grep -v ^D | cut -c3-)
# Retrieves the git diffs and filters out for the file name
files=$(git diff-index --name-status HEAD | grep -v ^D | cut -c3-)

jmbarbone

`%must_be%` <- function(x, value) {
  pr <- parent.frame()
  var_must_be(x, value, .call = match.call())
}

var_must_be <- function(x, value, .call = NULL) {
  mc <- if (is.null(.call)) match.call() else .call
  
  # maybe must_be_like?  where class(value) is in class(x) etc?

jmbarbone

recycle <- function(x, y, each = FALSE) {
  vals <- list(x, y)
  n <- lengths(vals)
  
  if (n[1] == n[2]) {
    return(vals)
  }
  
  
  if (n[1] == 0 | n[2] == 0) {

jmbarbone

# Char to Raw to Character
charToRaw("Jordan") |>
  as.character() |>
  as.hexmode() |>
  as.raw() |>
  rawToChar()

# Tricks |>
brackets <- `[[`

jmbarbone

foo1 <- function(x) {
  x[!is.na(x)]
}

foo2 <- function(x) {
  nas <- seq_along(x)[is.na(x)]
  if (length(nas)) x[-nas]  else x
}

foo3 <- function(x) {

jmbarbone

library(dplyr)

percentile_rank <- function(x, na.rm = TRUE) {
  p <- lengths(split(x, x)) / length(if (na.rm) na.omit(x) else x)
  (cumsum(p) - p * 0.5)[match(x, sort.int(unique(x)))] * 100
}

x <- runif(11)
tibble(x, order(x), percent_rank(x), percentile_rank(x))

jmbarbone

foo <- function(script_text, file = tempfile(), varlist = list()) {
  e <- list2env(varlist)
  dump(names(e), file = file, envir = e)
  s <- as.character(as.expression(substitute(script_text)))
  cat(s, "\n", file = file, append = TRUE)
  system2("rscript", c("--vanilla", file))
}

foo({a <- mean(a);  length(a)}, varlist = list(a = 1:10))

jmbarbone

# Not as quick as stringr but only base, so...
string_extract_all <- function(x, pattern, perl = FALSE, ignore.case = FALSE) {
  re <- gregexpr(pattern, x, perl = perl, ignore.case = ignore.case)
  mapply(

    function(xi, rei, lens) {
        substring(xi, rei, rei + lens - 1L)
    },
    xi = x,
    rei = re,

jmbarbone

y <- runif(2000)

foo_loop <- function(y) {
  m <- length(y)
  res <- matrix(nrow = m, ncol = m)
  
  for (i in 1:m) {
    for (j in 1:m) {
      res[i, j] <- all(y[i] <= y[j])
    }

jmbarbone

library(stringi)
requireNamespace("ggbeeswarm") # for bench::autoplot()
#> Loading required namespace: ggbeeswarm


get_marks <- function(stringi_exp, paste_exp) {
  stringi_exp <- substitute(stringi_exp)
  paste_exp <- substitute(paste_exp)
  
  suppressMessages(