R/comfy-functions.R

In tomathon-io/comfy: Comfy Functions For Your Best Code

#' @title A more intuitive take on base R's try function.
#'
#' @description Combines the benefits of try and else into one easy-to-use function.
#' @param expr The expression to be attempted.
#' @param el The return if expr fails. Can be a value or alternate function.
#' @param return_error Should the error message of a failed expr be returned? Defaults to FALSE.
#' @keywords try, else, ifelse
#' @export
#' @examples
#' bad_fun <- function() log("hello")
#' tryel(bad_fun(), 100)
#' good_fun <- function() log(10)
#' tryel(bad_fun(), good_fun())
tryel <- function(expr, el, return_error = FALSE){
  expr <- try(expr, silent = TRUE)
  if(inherits(expr, "try-error")){
    if(return_error){
      err_attr <- attributes(expr)$condition
      return(list("ret" = el, "error" = err_attr))
    } else{ return(el) }
  } else{ return(expr) }
}










#' @title A more practical version of base R's strsplit function.
#'
#' @description Splits a string, or a vector of strings, and returns the unlisted result.
#' @param string The string to be split. Can be a single string or a vector of strings.
#' @param split_by The separator on which to split the string. Defaults to any non-alphanumeric.
#' @keywords strsplit, split
#' @export
#' @examples
#' splitin("this is my string")
#' splitin("this/is.my-string")
#' my_strings <- c("This is my first string", "this.is/my--second*string")
#' splitin(my_strings)
splitin <- function(string, split_by = "[^[:alnum:]]+"){
  if(length(string) == 1){
    ret_ <- unlist(strsplit(string, split = split_by))
  } else{
    ret_ <- lapply(1:length(string), function(s){
      unlist(strsplit(string[s], split = split_by))
    })
  }
  return(ret_)
}










#' @title A multi-function to-do list of sorts.
#'
#' @description Pass multiple functions onto a single input in one call. Can be system or user-defined functions.
#' @param x The input on which to pass multiple functions.
#' @param ... The functions to be passed onto x.
#' @keywords apply, sapply, lapply, mapply
#' @export
#' @examples
#' fundo(1:7, mean, max)
#' fundo(1:7, mean, max, undefined_function)
#' get_min_col <- function(df){ "col_min" = apply(df, 2, min, na.rm = T) }
#' cars %>% fundo(summary, get_min_col)
fundo <- function(x, ...){
  funs <- sapply(match.call(expand.dots = FALSE)$..., deparse)
  if(!all(sapply(funs, exists))){
    stop(
      "All args to '...' must be defined functions", 
      call. = FALSE
    )
  }
  sapply(funs, function(f) suppressWarnings(eval(call(f, x))))
}