robertzk’s gists

robertzk / strip.rb

Created July 26, 2014 01:15

xml.gsub(/[0-9]{5,15}/) { |y| y =~ /^000/ ? y : y.split('').map{|w|0}.join}

robertzk / sexymunger.r

Created June 11, 2014 03:43

	as.list.formula <- function(x) {
	output <- vector('list', length(x))
	for(i in seq_len(length(x))) {
	could_be_formula <- length(x[[i]]) > 1 && is.element("~", all.names(x[[i]]))
	output[[i]] <-
	if (could_be_formula) as.list(as.formula(x[[i]]))
	else if (is.recursive(x[[i]])) as.list(x[[i]])
	else x[[i]]
	}
	output

robertzk / gist:9627546

Created March 18, 2014 19:28

	# Reload the suite of Syberia packages. This will be automated later.
	require(devtools)
	pkgs <- strsplit("Ramd productivus stagerunner statsUtils mungebitsTransformations mungebits tundra syberia", " ")[[1]]
	lapply(list(
	list(function(x) if(x %in% loadedNamespaces()) unloadNamespace(x), rev = TRUE),
	list(install_github, 'robertzk'),
	list(library, character.only = TRUE)
	), function(x) { r <- x$rev; x$rev <- NULL; do.call(lapply, append(list(if (is.null(r)) pkgs else rev(pkgs)), x)) })

robertzk / mystery_method.rb

Created January 10, 2014 01:19

	def mystery_method(x)
	->(z) do
	x.inject(z) { \|f, v\| f(v) }
	end
	end

robertzk / exists.r

Created December 6, 2013 22:48

R exercise: Write your own version of exists(inherits = FALSE) (Hint: use ls()). Write a recursive version that behaves like inherits = TRUE. http://adv-r.had.co.nz/Environments.html

	exists <- function(name, env = parent.frame(), inherits = TRUE) {
	if (identical(env, emptyenv())) return(FALSE)

	if (name %in% ls(envir = env)) TRUE
	else if (inherits) exists(name, parent.env(env))
	else FALSE
	}

robertzk / fget.r

Created December 6, 2013 22:41

R exercise: Write a function called fget() that finds only function objects. It should have two arguments, name and env, and should obey the regular scoping rules for functions: if there's an object with a matching name that's not a function, look in the parent. (This function should be a equivalent to match.fun() extended to take a second argum…

	fget <- function(name, env = parent.frame(), inherits = TRUE) {
	if (identical(env, emptyenv())) stop(name, ' not found')

	if (exists(name, env = env, inherits = FALSE) && is.function(tmp <- env[[name]])) return(tmp)
	else if (inherits) fget(name, parent.env(env))
	else stop(name, ' not found')
	}

robertzk / get.r

Last active December 30, 2015 12:48

R exercise: Write your own version of get() using a function written in the style of where(). http://adv-r.had.co.nz/Environments.html

	get <- function(name, env = parent.frame()) {
	if (identical(env, emptyenv())) stop(name, ' not found')

	if (exists(name, env = env, inherits = FALSE)) return(env[[name]])
	else get(name, parent.env(env))
	}

robertzk / randomreplace.r

Created December 6, 2013 00:36

R exercise: Create a replacement function that modifies a random location in vector. http://adv-r.had.co.nz/Functions.html

	"random<-" <- function(object, position, value) {
	object[sample(seq_along(object), 1)] <- value
	object
	}

	# Example:
	# > x <- c(1,2,3,4,5)
	# > random(x) <- 10
	# > x
	# [1] 1 10 3 4 5

robertzk / infixed.r

Created December 6, 2013 00:33

R exercise: Create infix versions of set functions: intersect(), union(), setdiff() http://adv-r.had.co.nz/Functions.html

	infixed_names <- list(intersect = '∩', union = 'U', setdiff = '-')

	create_infix_operator <- function(name, base_fn, e) {
	name <- paste("%", name, "%", sep = '')
	assign(name, function(x, y) get(base_fn, envir = e)(x, y), envir = e)
	}

	lapply(names(infixed_names), function(name) {
	create_infix_operator(infixed_names[[name]], name, e = parent.frame(2))
	})

robertzk / xor.r

Created December 6, 2013 00:05

R exercise: Create an infix xor() operator. http://adv-r.had.co.nz/Functions.html

`%xor%` <- function(x,y) (x || y) && !(x && y)

Robert Krzyzanowski robertzk