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

polygonizer <- function(x, outshape=NULL, pypath=NULL, readpoly=TRUE, 
                        fillholes=FALSE, aggregate=FALSE, 
                        quietish=TRUE) {
  # x: an R Raster layer, or the file path to a raster file recognised by GDAL 
  # outshape: the path to the output shapefile (if NULL, a temporary file will 
  #           be created) 
  # pypath: the path to gdal_polygonize.py or OSGeo4W.bat (if NULL, the function 
  #         will attempt to determine the location)
  # readpoly: should the polygon shapefile be read back into R, and returned by
  #           this function? (logical) 

johnbaums

patchify <- function(x, distance, p4s, givedist=TRUE) {
  # x: a binary Raster layer (0 or NA for background, and 1 for areas to be clumped)
  # distance: the neighbourhood distance. Patches that occur within this distance of 
  #           one another will be clumped. This should be in the units of the CRS given
  #           in p4s. If this is zero, the function will identify patches defined by 
  #           8-connectivity (i.e. queen's case).
  # p4s: an equal-area projection appropriate for the region. This will be used when 
  #      calculating inter-patch distances. The returned objects will be in the 
  #      original coordinate system.
  # givedist: should the distance matrix be returned? (logical). Distances are in the 

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

trim_raster <- function(x, value=NA, expand=0, pad=0, ...) {
  # x:      a Raster* object
  # value:  a (vector of) value(s) to be clipped out, e.g. c(0, NA)
  # expand: proportion by which to expand each dimension, e.g. 0.1 = 10%
  #         expansion of height and width after first cropping out exterior NA 
  #         rows/cols
  # pad:    either a single numeric value indicating the number of rows and 
  #         columns of NA to add after cropping out all exterior NA rows and 
  #         columns, or a vector of length 2 whose elements give the number of 
  #         rows and columns, respectively, of NA to add. If expand is > 0, pad

johnbaums

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

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