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

shade <- function(x, y, col, n=500, xlab='x', ylab='y', ...) {
  # x, y: the x and y coordinates
  # col: a vector of colours (hex, numeric, character), or a colorRampPalette
  # n: the vertical resolution of the gradient
  # ...: further args to plot()
  plot(x, y, type='n', las=1, xlab=xlab, ylab=ylab, ...)
  e <- par('usr')
  height <- diff(e[3:4])/(n-1)
  y_up <- seq(0, e[4], height)
  y_down <- seq(0, e[3], -height)

johnbaums

## Function to use GDAL to project coordinate reference system

# See http://www.gdal.org/gdalwarp.html for additional details 
# `resampling` can be 'near' (nearest neighbour), 'bilinear', 'cubic', or
# 'lanczos' (Lanczos windowed sinc resampling). 
# `extent` should be a bbox object or a vector of c(xmin, ymin, xmax, ymax)
# `of` is the output format (use GDAL short name as given by the name field of
# gdalDrivers(), or at http://www.gdal.org/formats_list.html)
# `extension` is the output extension corresponding to the primary file
# `ot` is the output type (see http://www.gdal.org/gdal_translate.html)

johnbaums

library(rasterVis)
library(latticeExtra)
library(RColorBrewer)
library(rgeos)

aus <- subset(readOGR('data/natural_earth', 'ne_10m_admin_1_states_provinces'),
              admin=='Australia' & gns_id != 0)
r <- raster()
extent(r) <- extent(aus)
r <- extend(r, 10)

johnbaums

swatches <- function(cols) {
  par(mfrow=n2mfrow(length(cols)), mar=c(0.2, 0.2, 2.5, 0.2))
  invisible(sapply(cols, function(x) {
    plot.new()
    plot.window(xlim=c(0, 1), ylim=c(0, 1))
    rect(0, 0, 1, 1, col=x, lwd=2, lend=1)
    mtext(x, 3, font=2)
  }))
}

johnbaums

jagstrace <- function(x, vars, col) {
  # x: a fitted JAGS object
  # vars: a vector of names of variables to be plotted, or if unspecified, plot all variables
  # col: a vector of colours to use for plotting chains
  if (!missing(vars)) {
    i <- sapply(vars, function(v) {
      grep(paste0('^', v, '$'), 
           sub('\\[.*\\]$', '', dimnames(x$BUGSoutput$sims.array)[[3]]))
    })
    z <- x$BUGSoutput$sims.array[, , i, drop=FALSE] 

johnbaums

stackhist <- function(x, breaks, col=rainbow(length(x)), ...) {
  #      x: A list of vectors for which histograms will be computed.
  # breaks: A vector of breaks or a single integer giving the 
  #         number of breaks.
  #    col: A vector of fill colours.
  col <- rev(col)
  if (length(breaks)==1) {
    rng <- range(pretty(range(x)))
    breaks <- seq(rng[1], rng[2], length.out=breaks)
  }

johnbaums

roundto <- function(x, to) to*round(x/to)

# examples:
# roundto(1.3132, 0.2)
# roundto(runif(10), 0.05)

johnbaums

split_max_groupsize <- function(x, n) split(x, gl(ceiling(length(x)/n), n, length(x)))