MyKo101

ggpipe <- function(data,...){
  len <- ...length()
  p <- ggplot(data)
  if(len > 0) for(i in 1:len){
    p <- p + ...elt(i)
  }
  p
}

palmerpenguins::penguins |>

MyKo101

na <- function (x) 
{
  x <- if (missing(x)) {
    prev_call <- sys.call(sys.nframe() - 2)
    if (identical(prev_call[[1]], quote(if_else)) | 
          identical(prev_call[[1]], quote(dplyr::if_else))) {
      prev_env <- sys.frame(sys.nframe() - 1)
      prev_env$x
    }
    else logical(1)

MyKo101

#Overloads the dplyr::filter() function with a chattier version
# provides two nouns for use in the glue-able text, 
#   .pre is the data before the filtering
#   .post is the data after the filtering


filter <- function(.data,...,.chat=NULL){
  this_call <- match.call()
  new_call <- this_call
  new_call[[1]] <- call("::",quote(`dplyr`),quote(`filter`))

MyKo101

library(tidyverse)
library(rando)

r_mutate <- function(.data,...,.nchars=3){
  nms <- names(.data)
  .call <- match.call()
  .call[[1]] <- call("::",quote(dplyr),quote(mutate))
  if(".nchars" %in% names(.call)) .call[[".nchars"]] <- NULL
  unnamed <- which(names(.call[-1]) == "")
  n_vars <- length(unnamed)

MyKo101

attribute_lock <- function(x){
  if(inherits(x,"attribute_lock")){
    x
  } else {
    ocl <- attr(x,"class")
    ncl <- if(!is.null(ocl)) c("attribute_lock",ocl) else "attribute_lock"
    structure(x,class=ncl)
  }

MyKo101

less_chain <- function(.a,a,b,equal=FALSE){
  if(length(a) != length(b) && (length(a) != 1 && length(b) != 1))
    stop("Incompatible lengths",call.=FALSE)
  if(is.call(.a) &&
     (identical(.a[[1]],quote(`%<%`)) || identical(.a[[1]],quote(`%<=%`)))){
    mid <- eval(.a[[3]])
    rhs <- if(equal) mid <= b else mid < b
    a & rhs
  } else if(is.numeric(a) && is.numeric(b)){
    if(equal) a <= b else a < b

MyKo101

listframe <- function(...){
  structure(
    tibble(...),
    class = c("listframe","tbl_df","tbl","data.frame")
  )
}

lf <- listframe(
  a = list(1,c("a","b","c"),matrix(1:4,2,2)),

MyKo101

#' Create a delayed evaluation of a call
#' 
#' Works similarly to `delayAssign()`, except it works as part of an assignment.
#' Can only be called from within a function and must be directly part of a left-assignment
#' This can be used to pass things like R CMD Check for delayed variables, rather than
#' using `delayedAssign("x",call)` is the equivalent of `x <- delayed_variable(call)`


delayed_variable <- function(call){
  

MyKo101

#' Apply on.exit() anywhere
#'
#' Apply the on.exit() functionality to any environment
#'
#' Very useful for creating and closing temporary connections (see examples)
#'
#' @examples
#'  local_sink <- function(file){
#'    sink(file)
#'    on.exit.env(sink(),env=parent.frame())

MyKo101

temp_env <- new.env() #Create a new environment
if("LoadedEnv" %in% search()) detach("LoadedEnv") #If this has previously been run, remove it!
ff <- list.files("functions",full.names=TRUE) #Load up the files in the functions folder
silencer <- lapply(ff,source,local=temp_env) #source them all into the temporary environment
attach(temp_env,name="LoadedEnv") #Add the environment to the search path
rm(temp_env,ff,silencer) #Clean up