moodymudskipper

pipe_diff <- function() {
  pipe <- function (lhs, rhs) {
    on.exit({
      extra <- 
        if(tibble::is_tibble(lhs) && tibble::is_tibble(res)) 
          list(n=Inf, width = Inf) else list()
      previous <-  lhs
      added_nm <- deparse(expr)[[1]]
      assign(added_nm, res)
      diff_obj_expr <- substitute(

moodymudskipper

set_invisible_attr <- function(x, ...) {
  x_chr <- as.character(substitute(x))
  pf <- parent.frame()
  if(bindingIsActive(x_chr, pf)) {
    env <- environment(activeBindingFunction(x_chr, pf))
    args <- list(...)
    env$closure$attrs[names(args)] <- args
    return(x)
  }

moodymudskipper

#' Make a variable chatty
#'
#' Call `chatty(x, y)` to make the variables `x` and `y` chatty. A message
#' will then be printed every time they are accessed or modified. If you set
#' deep to true, when the variable is given directly as an argument to a function
#' (as in `fun(x)` but not `fun(x + 1)` the argument will become chatty again.
#'
#' @param ... variables to make chatty
#' @param f function to used on modified values before printing them, by default
#'   the full modified object is printed

moodymudskipper

date_picker <- function(time = FALSE) {
  withr::with_package("shiny",{
    ui <- fluidPage(
      shinyWidgets::airDatepickerInput(
        inputId = "widget",
        timepicker = time,
        inline = TRUE
      ),
      if(time) actionButton("button", "ok")
    )

moodymudskipper

``` r
matched.arg <- function(...) {
  c(...)[1]
}

match.args <- function() {
  formal.args <- formals(sys.function(sysP <- sys.parent()))
  formal.args <- Filter(function(x) is.call(x) && identical(x[[1]], as.name("matched.arg")), formal.args)
  env <- sys.frame(sysP)
  for (arg in names(formal.args)) {

moodymudskipper

library(tidyverse)
dups <- dupree::dupree_dir(filter = "\\.[rR]$") 
markers <- dups %>% 
  as_tibble() %>% 
  mutate(message = paste("duplicate", row_number())) %>% 
  mutate_all(as.character) %>% 
  pivot_longer(c(line_a, line_b, file_a, file_b), names_to = "name", values_to = "val") %>% 
  separate(name, c("type", "letter")) %>% 
  pivot_wider(names_from = type, values_from = val) %>% 
  transmute(

moodymudskipper

``` r
chatty <- function(x, f = identity) {
  caller_env <-  parent.frame()
  closure <- new.env(parent = caller_env)
  f_sym <- substitute(f)
  if (is.function(f)) {
    f_name <- as.character(f_sym)
    f <- list(f)
    if(is.symbol(f_sym) && ! f_name %in% c("", "identity")) {
      names(f) <- f_name

moodymudskipper

`[` <- function(x, ...) {
  base::`[`(x, ...)
}

makeActiveBinding(".I", function() {
  sc <- sys.calls()
  fr <- which(vapply(sc, \(x) capture.output(x)[1], character(1)) == "base::`[`(x, ...)")
  fr <- fr[length(fr)]
  sf <- sys.frames()[[fr-1]]
  x <- eval(quote(x), sf)

moodymudskipper

fake_package <- function(name, exported = NULL, unexported = NULL, attach = TRUE) {
  # fetch and eval call to create `makeNamespace`
  eval(body(loadNamespace)[[c(8, 4, 4)]])
  # create an empty namespace
  ns <- makeNamespace(name)
  # makethis namespace the closure env of our input functions
  exported <- lapply(exported, `environment<-`, ns)
  unexported <- lapply(unexported, `environment<-`, ns)
  # place these in the namespace
  list2env(exported, ns)

moodymudskipper

# define `makeNamespace` function
eval(body(loadNamespace)[[c(8, 4, 4)]])

ns <- makeNamespace("fake")

# define functions
ns$foo <- function() "foo!"
ns$bar <- function() "bar!"

# export some