johnbaums’s gists

johnbaums / tpl_get2.R

Last active December 25, 2015 09:59

Improved tpl_get, based on tpl_get in the taxize package (http://cran.r-project.org/web/packages/taxize/index.html). Downloads plant species records (with accepted names) indexed by theplantlist.org.

	tpl_get2 <- function (dir_, family = NULL)
	{
	require(RCurl)
	require(XML)
	require(plyr)
	temp <-getURL('http://www.theplantlist.org/browse/-/')
	temp <- htmlParse(temp)
	families <- xpathSApply(temp, "//ul[@id='nametree']//a", xmlValue)
	csvlinks <- sprintf('http://www.theplantlist.org%s%s.csv',
	xpathSApply(temp, "//ul[@id='nametree']//a", xmlGetAttr, 'href'),

johnbaums / tpl_families.R

Created October 13, 2013 05:30

List plant families indexed by theplantlist.org

	tpl_families <- function () {
	require(RCurl)
	require(XML)
	temp <- getURL('http://www.theplantlist.org/browse/-/')
	temp <- htmlParse(temp)
	families <- xpathSApply(temp, "//ul[@id='nametree']//a", xmlValue)
	groups <- factor(basename(dirname(xpathSApply(temp,
	"//ul[@id='nametree']//a",
	xmlGetAttr, 'href'))),
	levels=c('A', 'B', 'G', 'P'),

johnbaums / tpl_genera.R

Last active December 25, 2015 11:29

Return genera listed by theplantlist.org. Provide a vector of family names with argument 'family' to restrict to one or more families.

	tpl_genera <- function (family=NULL) {
	require(RCurl)
	require(XML)
	require(plyr)
	if (!is.null(family)) {
	if (!exists('tpl_families') \|\| !is.function(tpl_families)) {
	stop(paste('If providing family names, the function "tpl_families" is required.',
	'See https://gist.github.com/johnbaums/6958504.', sep='\n'),
	call.=FALSE)
	}

johnbaums / gbif_parse.R

Last active December 25, 2015 11:49

Parse taxon names from R, using the GBIF name parser API (http://portaldev.gbif.org/developer/species).

	gbif_parse <- function(x) {
	# x is a vector of species names
	library(RJSONIO)
	library(RCurl)
	library(plyr)
	u <- "http://api.gbif.org/v1/parser/name"
	res <- fromJSON(
	postForm(u,
	.opts = list(postfields = RJSONIO::toJSON(x),
	httpheader = c('Content-Type' = 'application/json')))

johnbaums / parsePub.R

Last active December 25, 2015 15:39

parsePub: Parse publication details (provided in JSON format) returned by sortPubsToHTML: sorts pubs by year and parse with parsePub, optionally sending output to a text file. Here, pubs refers to a list of publications in JSON format, each of which is returned by the Mendeley Group Document Details method - http://apidocs.mendeley.com/home/user…

	parsePub <- function(x, emphasize=NULL) {
	if (!is.null(emphasize)) {
	lname <- sapply(strsplit(sapply(x$authors, '[[', 2), '\\s+'), tail, 1)
	finit <- substr(sapply(x$authors, '[[', 1), 1, 1)
	em.lname <- sapply(strsplit(emphasize, '\\s+'), tail, 1)
	em.finit <- substr(emphasize, 1, 1)
	em <- !is.na(match(paste(finit, lname), paste(em.finit, em.lname)))
	}

	authsToVec <- function(y, emphasize=emphasize) {

johnbaums / getAVH.R

Last active December 28, 2015 12:09

Get plant species occurrence records from the AVH hub of ALA (ala.org.au)

	getAVH <- function(species, sleepInterval=0, progress=TRUE, verbose=FALSE, outpath=NULL) {
	require(httr)
	require(plyr)
	avh <- handle('http://biocache.ala.org.au')
	.getAVH <- function(x) {
	sp <- gsub('\\s+', '+', x)
	cfg <- c(accept_json())
	if (isTRUE(verbose)) cfg <- c(cfg, verbose())
	tt1 <- GET(handle=avh, path='ws/occurrences/search',
	config=cfg,

johnbaums / lintemp.R

Last active December 19, 2023 10:36

Linear temporal interpolation and extrapolation of raster stacks

	#### Temporal Interpolation ####################################################
	# Perform cell-wise linear interpolation between multiple raster layers, and
	# extrapolation beyond the upper limit of input data. Output is saved in .tif
	# format.
	#
	# Arguments
	# s: a rasterStack containing the time slices to be interpolated
	#
	# xin: a numeric vector that indicates the times associated with layers in s (in
	# the same order as the layers of s - see names(s))

johnbaums / identicons.R

Created June 23, 2014 18:13

Generating identicons for fun and profit

	# PHP source at http://scott.sherrillmix.com/blog/blogger/wp_identicon/
	# http://www.gravatar.com/avatar/b1554c62bf1d05a4a9c48754a6619c17.png?d=identicon
	# Related SO post: http://stackoverflow.com/q/24347608/489704

	# Download and read in PHP source for shape creation
	download.file('http://downloads.wordpress.org/plugin/wp-identicon.zip',
	destfile=f <- tempfile())
	unzip(f, exdir=tempdir())
	txt <- readLines(file.path(tempdir(), 'wp-identicon', 'wp_identicon.php'),
	warn=FALSE)[55:98]

johnbaums / get.mnist.R

Last active August 29, 2015 14:08

Download and import MNIST handwritten numeral datasets

	get.mnist <- function(dir=NULL) {
	# dir: the path containing the extracted files:
	# train-images-idx3-ubyte
	# train-labels-idx1-ubyte
	# t10k-images-idx3-ubyte
	# t10k-labels-idx1-ubyte
	if(is.null(dir)) {
	require(R.utils)
	dir <- tempdir()
	u <- c('http://yann.lecun.com/exdb/mnist/train-images-idx3-ubyte.gz',

johnbaums / iwanthue.R

Last active October 24, 2024 19:45

Palettes of distinct colours, generated through kmeans clustering of LAB colour space

	swatch <- function(x) {
	# x: a vector of colours (hex, numeric, or string)
	par(mai=c(0.2, max(strwidth(x, "inch") + 0.4, na.rm = TRUE), 0.2, 0.4))
	barplot(rep(1, length(x)), col=rev(x), space = 0.1, axes=FALSE,
	names.arg=rev(x), cex.names=0.8, horiz=T, las=1)
	}

	# Example:
	# swatch(colours()[1:10])
	# swatch(iwanthue(5))

John johnbaums