moodymudskipper

######### machine learning ##########
snippet _hclust
	model <- hclust(dist(iris[-5]), method="complete")            # define model
	predicted <- cutree(model,k=3)                                    # cut tree (get cluster membership)
	plot(model)                                                   # plot dendogram
	plot(iris$Sepal.Length, iris$Sepal.Width, col = predicted)        # result by 2 variables
	plot(iris$Sepal.Length, iris$Sepal.Width, col = iris$Species) 

######### misc ##########

moodymudskipper

# this function will run a rmd report in a "clean environment", which means it 
# ignores what's in the global environment and what packages have been attached.
# It can be fed adhoc parameters however.
#
# "clean environment" is between quotes because loaded namespaces in the 
# original environment CAN influence the report, and the rmd rendering CAN alter
# the loaded namespaces.
#
# In practice this should not be an issue in most cases but let it be said that
# the only known way to be sure about the reproduciblity of a report is to knit

moodymudskipper

Not sure exactly how useful that would be but that'd be a fun small package.

The following `infix` function parses an expression containing 
multiple infix operators so we can do things like `infix(x %is_between% y %and% z)`, i.e an "infix operation" with more than 2 parameters.

See example.

The name `infix` is not great.

```

moodymudskipper

We often need to do set operations on lists, where the actual unions or
intersections happen on names, not content, and special treatment is to be
applied in the content.

We propose a way to generalize set operations, take the following examples:

```
X <- list(a = 1, b = 2:3, c = 4)
Y <- list(b = 3:4, d = 6)

moodymudskipper

# on.exit for scripts, on.exit2 will create, update or overwrite 
# the object .on.exit.exprs (of class expression) in the calling environment
# at the end of the script we evaluate .on.exit.exprs
on.exit2 <- function(expr = NULL, add = FALSE, after = TRUE){
  if(!exists(".on.exit.exprs", parent.frame())) 
    assign(".on.exit.exprs",expression(), envir = parent.frame())
  if(add){
    if(after)
      .on.exit.exprs <<- c(.on.exit.exprs, substitute(expr))
    else

moodymudskipper

expect_same_behavior <- function(object, expected, ...){
  object_chr <- deparse(substitute(object))
  expected_chr <- deparse(substitute(expected))
  quiet <- purrr::safely(purrr::quietly(identity))
  object   <- eval(substitute(quiet(object)))
  expected <- eval(substitute(quiet(expected)))
  testthat::expect(
    identical(object$result$result, expected$result$result, ...),
    sprintf("`%s` and `%s` don't return the same result.", object_chr, expected_chr))
  testthat::expect(

moodymudskipper

``` r
#' print list nicely
#'
#' @param l list to print
#' @param n_named max number of named items to display if list/sublist contains only named items
#' @param n_unnamed max number of items to display if list/sublist contains unnamed items 
#' @param fun function to use to print items
#' @param ... additional arguments passed to fun
#'
#' @return unchanged input

moodymudskipper

``` r
#################################################
# DEFINE TAGS / TAG ADVERBS USING PACKAGE {tag} #
#################################################

# remotes::install_github("moodymudskipper/tag")
mapping_impl <- tag::tag(
  args = alist(.pmap =),
  {
    # setup

moodymudskipper

library(ggplot2)
scale_y_duration <- function(..., units = c("s","min","h","day")){
  units <- match.arg(units, c("ms","seconds","minutes","hours","days", "weeks", "months", "years"),
                     several.ok = TRUE)
  # to get them in the right order
  units <- intersect(c("ms","seconds","minutes","hours","days", "weeks", "months", "years"), units)

  ms    <- 1/1000
  min   <- 60
  h     <- 60 *min

moodymudskipper

``` r
# devtools::install_github("moodymudskipper/help")
library(help)
library(tidyverse, warn.conflicts = F)
env <- as.environment("package:dplyr")
dplyr_funs <- ls(envir = env)
arg_descr <- sapply(dplyr_funs, function(x) {
  if(!is.function(get(x,envir = env))) return("not a function")
  arg_nm <- names(formals(x,envir = env))[[1]]
  if(!length(arg_nm)) return("no argument")