vankesteren’s gists

vankesteren / covmat_generation.R

Last active March 1, 2018 12:42

Interactively specifying a randomly generated covariance matrix

	if (!require(manipulate)) {install.packages("manipulate"); library(manipulate)}

	manipulate({
	corImg <- function(cor, ...) {
	p <- dim(cor)[1]
	if (sum(diag(cor)) != p) cor <- cov2cor(cor)
	plotS <- abs(cor)
	plotS[lower.tri(cor)] <- NA
	diag(plotS) <- NA

vankesteren / objectsizes.R

Last active April 9, 2018 13:56

Display object sizes from large to small with human-readable formatting. It's a really ugly function with a double sapply in there, but it does its job well.

	object.sizes <- function(unit = "auto", all = FALSE) {
	data.frame(size =
	sapply(
	sort(
	sapply(ls(envir = parent.frame(), all.names = all), function(x) {
	object.size(get(x, envir = parent.frame()))
	}),
	decreasing = TRUE
	),
	function(y) {

vankesteren / recursiveInts.R

Created April 16, 2018 07:47

	ints <- function(start, end) {
	if (start > end) return(NULL)
	return(c(start, ints(start + 1, end)))
	}

vankesteren / recursiveMult.R

Last active April 18, 2018 08:14

Recursive multiplication. Only works for positive numbers

	multiply <- function(a, b) {
	if (a > 1e-15) return(0) # exit clause
	a + multiply(a*(1-1/b), b)
	}

vankesteren / recursion.R

Last active April 18, 2018 21:14

A few recursive R algorithms

	# Sequences
	# sequence of integers
	int=function(s,e)if(s<=e)c(s,int(s+1,e))
	int(2, 12)

	# nth fibonacci number
	fib=function(n)ifelse(n<=1,1,fib(n-1)+fib(n-2))
	fib(0:10)

	# Mathy stuff

vankesteren / _svdimage.R

Last active April 20, 2018 09:52

SVD images

	library(imager)
	img <- load.image("~/hearts.jpg")
	mat <- img[,,1,1]

	s <- svd(mat)
	s$u%%diag(s$d)%%t(s$v)

	lrd <- s$d
	lrd[-c(1:15)] <- 0
	newimg <- img

vankesteren / by.R

Last active June 6, 2018 15:29

Operator to perform an expression by group / conditionally on a factor / given a condition

	`%\|%` <- function(expr, group) {
	group <- as.factor(group)

	q <- rlang::enquo(expr)
	exx <- rlang::quo_get_expr(q)
	evv <- rlang::quo_get_env(q)

	glb <- codetools::findGlobals(as.function(list(exx)))
	gets <- lapply(glb, get, envir = evv)
	names(gets) <- glb

vankesteren / message.txt

Last active June 11, 2018 08:00

A nice startup message for R

	RStudio Message
	RStudio has detected an error:
	Your colleagues are out of coffee, go bring them some.

vankesteren / sm.R

Last active June 11, 2018 08:03

startup message

	link <- "https://rawgit.com/vankesteren/4ee77beeccd23e8c09206f9652cbba58/raw/message.txt"
	o <- capture.output(lns <- try(suppressWarnings(readLines(link))), type = "m")
	if (!inherits(lns, "try-error") && rstudioapi::isAvailable()) {
	rstudioapi::showDialog(lns[1], paste(lns[-1], collapse = "\n"),
	"https://youtu.be/dQw4w9WgXcQ")
	}

vankesteren / param_ridges.R

Last active July 28, 2018 10:54

Pretty ridges plot for stan parameters

	# Pretty ridges plot for stan parameters
	# MIT license (c) Erik-Jan van Kesteren 2018
	# WARNING: sourcing this function will install/update packages

	if (requireNamespace("devtools", quietly = TRUE)) {
	suppressMessages(devtools::install_github("vankesteren/firatheme"))
	suppressMessages(devtools::install_cran(c("dplyr", "tidyr", "forcats",
	"ggplot2", "ggridges")))
	param_ridges <- function(stanfit, params, ...) {
	stopifnot(class(stanfit) == "stanfit")

Erik-Jan van Kesteren vankesteren