johnbaums

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 <- 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 <- 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 <- 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 <- 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 <- 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

#### 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

# 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 <- 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

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))