coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' A strict version of '%in%' where both the in-group and out-group must be completely specified
#'
#' The membership test is strict.
#'   - if 'universe' is defined, then `outgroup = setdiff(universe, ingroup)`
#'   - Every value of 'x' must exist within either 'ingroup' or 'outgroup'
#'   - 'ingroup' and 'outgroup' must be disjoint sets
#'   - May specify only one of 'outgroup' or 'universe'

#'

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' A version of 'memoise::memoise' with limits on individual object size
#'
#' @param f     Function of which to create a memoised copy.
#' @param ... optional variables specified as formulas with no RHS to use as
#' additional restrictions on caching. See Examples for usage.
#' @param envir Environment of the returned function.
#' @param cache Cache function.
#' @param object_size_limit maximum size of objects stored in cache.
#'        Default: 1048576 bytes (1MB)

coolbutuseless

check <- function(dog, location) { cat("Checking for", dog, "in", location, "\n") }


dogs      <- c('poodle', 'greyhound', 'mutt')
locations <- c('park', 'street', 'yard')

coolbutuseless

library(purrr)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Proof-of-concept
# Python style list comprehensions in R
# [ expression for item in list if conditional ]
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
lc <- 'dummy'
class(lc) <- 'listcomprehension'
`[.listcomprehension` <- function(...) {

coolbutuseless

```{r results='hide'}
vec <- c(101, 102, 103)
mat <- matrix(c( 1,  2,  3,
                 4,  5,  6,
                 7,  8,  9,
                10, 11, 12), nrow = 4, byrow = TRUE)
```

```{r}

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Inner recursive routine for solving Countdown numbers puzzle
#'
#' @param nums What numbers are left to select from?
#' @param value the current calculated value
#' @param expr the current readable expression
#' @param verbose output solutions as they are found? default: FALSE
#'
#' @return Character vector of solutions if any are found, otherwise NULL
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

coolbutuseless

suppressPackageStartupMessages({
  library(dplyr)
  library(ggplot2)
  library(metR)
  library(tidyr)
})


#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Load a black and white Mona Lisa. 

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Simple demo of a 10 argument function
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
nargs      <- 10
f          <- function() {}
fargs      <- as.pairlist(setNames(rep(1, nargs), paste0('v', seq(nargs))))
formals(f) <- fargs
f

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Create a CSS ruleset
#'
#' Create a CSS ruleset  consisting of a selector and one-or-more property declarations,
#' or, if no \code{.selector} is given, create an inline style string
#'
#' The list of included properties is not a complete list, but rather an
#' abbreviated list from
#' \url{https://developer.mozilla.org/en-US/docs/Web/CSS/CSS_Properties_Reference}

coolbutuseless

library(minisvg)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Define filter with turbulence driving the displacmenet
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
my_filter <- stag$filter(
  id = "displacementFilter",
  x = "-30%", y = "-30%", width="160%", height="160%",
  stag$feTurbulence(
    type          = "turbulence",