Skip to content

Instantly share code, notes, and snippets.

View wrathematics's full-sized avatar

Drew Schmidt wrathematics

236 followers · 5 following
View GitHub Profile
@wrathematics
wrathematics / grepfun
Last active August 29, 2015 14:00
Searching an R Function's R-level Source
stopper <- function(fun)
{
stop(paste("in match_src() : function fun='", fun, "' not found", sep=""), call.=FALSE)
}
match_src <- function(fun, pattern, ignore.case=FALSE, perl=FALSE, value=FALSE, fixed=FALSE, useBytes=FALSE, invert=FALSE, remove.comments=TRUE)
{
### This is really too complicated, I apologize
err <- try(test <- is.character(fun), silent=TRUE)
@wrathematics
wrathematics / printing_strings
Created May 2, 2014 03:14
Printing strings "a" to "zzzzz"
# The task:
# Print strings from "a" to "zzzzz" without using any loop or conditional statements. Don't just write all 1000 permutations out by hand. The output should look like this:
# a
# b
# c
# ...
# aa
# ab
# ac
@wrathematics
wrathematics / gist:094e361cb94557878d16
Created September 9, 2014 17:48
Sampling
library(Rcpp)
body <- "
SEXP foo(const int len, Rcpp::NumericVector pr)
{
Rcpp::IntegerVector ret(len);
RNGScope();
for (int i=0; i<len; i++)
{
@wrathematics
wrathematics / gist:94be9aa5fc47b37f42f5
Created September 11, 2014 13:22
String addition
"+" <- function(e1, e2){
if (typeof(e1) == "character" && typeof(e2) == "character")
return(paste0(e1, e2))
else
return(base::`+`(e1, e2))
}
"a" + "b"
1 + 2
"1" + 2
@wrathematics
wrathematics / gist:ff32004ace5fdee2cf28
Created September 28, 2014 17:42
ifelse sugar
# DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
# Version 2, December 2004
#
# Copyright (C) 2004 Sam Hocevar <sam@hocevar.net>
#
# Everyone is permitted to copy and distribute verbatim or modified
# copies of this license document, and changing it is allowed as long
# as the name is changed.
#
# DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE
@wrathematics
wrathematics / gist:77e75c3340b51a394526
Created September 29, 2014 19:14
Quantile algorithms and numerical issues
set.seed(1234)
x <- rnorm(10)/1e7
quantile(x, type=1)
# 0% 25% 50% 75% 100%
# -2.345698e-07 -8.900378e-08 -5.644520e-08 4.291247e-08 1.084441e-07
quantile(x, type=4)
# 0% 25% 50% 75% 100%
# -2.345698e-07 -1.048552e-07 -5.644520e-08 3.532770e-08 1.084441e-07
@wrathematics
wrathematics / install_if_needed
Created October 22, 2014 17:29
Wrapper for install.packages() to install an R package only if necessary (checks library and, if installed, current package version)
install_if_needed <- function(pkgs, lib=NULL, repos=getOption("repos"),
contriburl=contrib.url(repos, type), method, available=NULL, destdir=NULL,
dependencies=NA, type=getOption("pkgType"), configure.args=getOption("configure.args"),
configure.vars=getOption("configure.vars"), clean=FALSE, Ncpus=getOption("Ncpus", 1L),
verbose = getOption("verbose"), libs_only=FALSE, INSTALL_opts, quiet=FALSE,
keep_outputs=FALSE,
check_version=TRUE,
...)
{
installed <- installed.packages()
@wrathematics
wrathematics / gist:8a37b7b5b011e69ec88c
Created November 13, 2014 16:27
print methods
setMethod("print", signature(x="logical"),
function(x)
{
if (is.na(x))
base::print("who knows?")
else if (x)
base::print("to be sure")
else
base::print("nope")
}
@wrathematics
wrathematics / gist:2861e5e93dda849fb442
Created November 26, 2014 19:29
"genderize"
### Determining (poorly) the sex of a person based on their name.
### Based on this post: http://thedailywtf.com/articles/genderize
genderize <- function(name)
{
regex <- "(ua|pher|andy|elijah)$"
if (grepl(x=name, pattern=regex, ignore.case=TRUE))
return("male")
@wrathematics
wrathematics / gist:2e4996408c9750c16327
Created November 26, 2014 19:52
"genderize" test with the babynames dataset
library(babynames)
genderize <- function(name)
{
regex <- "(ua|pher|andy|elijah)$"
if (grepl(x=name, pattern=regex, ignore.case=TRUE))
return("male")
regex <- "(a|i|y|ah|ee|et|ette|elle|fer|ine|lyn|ie|anne|een|en|er|yn|ynn|kim|rachel|lind|pam|sue)$"