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

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
#' Stricter version of case_when()
#'     - disallows a fall-through 'TRUE' value on the LHS. 
#'     - disallows input values which do not match any rules. 
#'     - disallows input values which match more than one rule
#'
#' @param ... arguments to case_when
#'    
#' @return A vector of length 1 or n, matching the length of the logical input 
#' or output vectors, with the type (and attributes) of the first RHS. 

coolbutuseless

library(dplyr)
library(curl)
library(rvest)
library(xml2)
library(purrr)

# This script will download all the Brisbane City Council standard drawings.

bsd_url <- 'https://www.brisbane.qld.gov.au/planning-building/planning-guidelines-tools/planning-guidelines/standard-drawings'

coolbutuseless

library(tidyverse)
library(raster)
library(gganimate)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Not going to directly link in to script to avoid hitting server
# https://www.spriters-resource.com/resources/sheets/12/12593.png
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
sprite_sheet <- png::readPNG("12593.png")

coolbutuseless

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# ggplot2: Bug or Feature?
#
# Problem: stat_summary is calculated after axes are transformed.
#
# Expected:
#   Median at x=0 is 0, and median at x=1 is 1
#   Expect line from (0, 0) to (1, 1)
#
# Actual

coolbutuseless

#rstats
library(tidyverse)
d=c(1,5,3,11,9,7,15,13,6,14)
d=c(d,d+16,d+48,d+32)
L=setNames(c(1:22,40,23:25),letters)
D=map(d[L[strsplit('braille','')[[1]]]],~intToBits(.x)[1:6]>0)
P=data.frame(D=unlist(D),x=0:1+rep(seq(D),e=6)*3,y=rep(2:0,e=2))
ggplot(P)+geom_point(aes(x,y,size=D))

coolbutuseless

#rstats #unpipe
library(rlang)
U=function(ee){A=call_args;N=call_name;C=call2;I=is_call
if(!I(ee)){return(ee)}
f=N(ee)
u=purrr::map(A(ee),U)
if(f=="%>%"){l=u[[1]]
r=u[[2]]
if(I(r)){C(N(r),!!!c(l,A(r)))}else{C(r,l)}}else{C(f,!!!u)}}

coolbutuseless

library(tidyverse)

#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
# Base R styel
#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
filter_base <- function(df, boolean_expression) {

  # Don't evaluate what we were given. Just hold it.
  captured_expression <- substitute(boolean_expression)

coolbutuseless

#rstats #morse #sos
library(purrr);
s=strsplit;
flatten(map(s('sos','')[[1]],~set_names(s(s('._ _... _._. _.. . .._. __. .... .. .___ _._ ._.. __ _. ___ .__. __._ ._. ... _ .._ ..._ .__ _.._ _.__ __..',' ')[[1]],''),letters)[[.x]]))%>%walk(~{beepr::beep((.x=='_')+1);Sys.sleep(.5)})

coolbutuseless

library(bit)
library(R6)

#-----------------------------------------------------------------------------
# Outline of an R6 class to wrap a logical vector that may take values: TRUE, FALSE or NA
#
# This uses the 'bit' package for 2-bit booleans (1 bit for t/f and 1bit for NA status)
#
# This uses less memory than a normal logical vector (which uses 32 bits for