johnbaums

pbsapply <- function(x, fun, pass_to, ...) {
  if(!missing('pass_to')) {
    call <- sprintf('fun(%s=x[[i]], ...)', pass_to)
  } else {
    call <- 'fun(x[[1]], ...) '
  }
  sapply(seq_along(x), function(i) {
    cat(sprintf('\r%.02f%%', i/length(x)*100))
    eval(parse(text=call))  
  })

johnbaums

library(raster)
library(rasterVis)
library(RColorBrewer)
library(grid)
library(viridisLite)

r1 <- raster(matrix(runif(100), 10))
r2 <- raster(matrix(runif(100), 10))
xy <- xyFromCell(r1, sample(ncell(r1), 10), spatial=TRUE)
dif <- raster::extract(r2, xy) - raster::extract(r1, xy)

johnbaums

ramp <- function(values, cols, n) {
  # values: a sorted vector of values
  # col: a vector of colours corresponding to the values
  # n: total number of colours to create
  scale01 <- function(x) (x - min(x, na.rm=TRUE))/diff(range(x))
  round2 <- function(x) {
    # ensures sum of rounded values is maintained
    y <- floor(x)
    i <- tail(order(x-y), round(sum(x)) - sum(y))
    y[i] <- y[i] + 1

johnbaums

  flip_legend <- function(m) {
    # m: a `mapview` or `leaflet` object
    if(methods::is(m, 'mapview')) {
      calls <- methods::slot(m, 'map')$x$calls
    } else if((methods::is(m, 'leaflet'))) {
      calls <- m$x$calls
    } else {
      stop('m must be a mapview or leaflet object.')    
    }
    i <- grep('addLegend', sapply(calls, '[[', 'method'))

johnbaums

exdet <- function (ref, p) {
  # ref: data.frame of environments at reference locations.
  # p: data.frame of environments to assess.
  # See ?ecospat::ecospat.climan for more info.
  ex <- rowSums(mapply(function(ref, p) {
    rng <- range(ref)
    x <- findInterval(p, rng)
    ifelse(x==0, (p-rng[1])/diff(rng),
           ifelse(x==1, 0, (rng[2]-p)/diff(rng)))
  }, ref, p))

johnbaums

hexToChar <- function(x) {
  x <- sub('^0x', '', x)
  sapply(x, function(y) {
    h <- sapply(seq(1, nchar(y), by=2), function(i) substr(y, i, i+1))  
    rawToChar(as.raw(strtoi(h, 16L)))  
  })
}

charToHex <- function(x, prepend0x=TRUE) {
  sapply(x, function(y) {

johnbaums

get_cmip5 <- function(variable, gcm, rcp, season, time1, time2, ext, outdir,
                      dataset_id, read_in=TRUE, quiet=TRUE) {
  # variable can be:
  #  'pr' (precipitation)
  #  'tas' (temperature)
  #  'tasmax' (minimum temperature)
  #  'tasmin' (maximum temperature)
  #  'rsds' (solar radiation)
  #  'sfcWind' (wind speed)
  #  'hurs' (humidity)

johnbaums

add_transparency <- function(x, alpha_raster, ramp, ...) {
  # x: The raster to plot, to which transparency will be added.
  # alpha_raster: A raster with the same extent, resolution and CRS as `x`, with
  #    values indicating relative opacity. The maximum value of alpha_raster is
  #    assigned full opacity; lower values scale linearly to zero.
  # ramp: A function (like that returned by colorRampPalette) that returns a 
  #    vector of hexadecimal colour values.
  # ...: additional arguments passed to rasterVis::levelplot.
  require(raster)
  require(rasterVis)

johnbaums

hatch <- function(x, density) {
  # x: polygon object (SpatialPolygons* or sf)
  # density: approx number of lines to plot
  require(sp)
  require(raster)
  e <- extent(x)
  w <- diff(e[1:2])
  x1 <- seq(xmin(e), xmax(e)+w, length.out=floor(density*2))
  x0 <- seq(xmin(e)-w, xmax(e), length.out=floor(density*2))
  y0 <- rep(ymin(e), floor(density*2))

johnbaums

gdal_weightedmean <- function(infile, outfile, weights, return_raster=FALSE, overwrite=FALSE) {
  # Be aware that the outfile type will be the same as the infile type
  require(rgdal)
  if(return_raster) require(raster)
  # infile:        The multiband raster file (or a vector of paths to multiple 
  #                 raster files) for which to calculate cell mean.
  # weights:       The weights to apply to each layer. If missing, equal weights
  #                 assumed.
  # outfile:       Path to raster output file.
  # return_raster: (logical) Should the output raster be read back into R?