johnbaums

# based on https://stackoverflow.com/q/51209112/489704
library(lattice)
library(dplyr)
library(tidyr)

my.panel.bands <- function(x, y, upper, lower, fill, col, subscripts, ..., 
                           font, fontface) {
  upper <- upper[subscripts]
  lower <- lower[subscripts]
  panel.polygon(c(x, rev(x)), c(upper, rev(lower)), col=fill, border=FALSE, ...)

johnbaums

confusion <- function(obs, pred, thr=NULL) {
  # obs: a vector of observed binary values (0, 1)
  # pred: a vector of continuous predictions (range: 0-1)
  # thr: a numeric scalar specifying the value at which to threshold 
  #      `pred`, or NULL if pred is already binary.
  if(is.null(thr) && !all(pred %in% 0:1)) {
    stop('If thr=NULL, all pred must be either 0 or 1.')
  }
  if(any(pred > 1) || any(pred < 0)) {
    stop('pred must all be between 0 and 1 (inclusive).')

johnbaums

get_namespaces <- function(file, as_imports=FALSE) {
  require(stringi)
  require(dplyr)
  
  nm <- readLines(file) %>% 
    stringi::stri_extract_all(regex='[\\w_.]+::[\\w_.]+') %>% 
    unlist %>% 
    setdiff(NA) %>% 
    sort
  

johnbaums

export PYTHON_VERSION=3.4.3
export PYTHON_SHORT_VERSION=3.4
export GEOS_VERSION=3.6.2
export GDAL_VERSION=2.2.2
export PROJ4_VERSION=4.9.3

sudo yum-config-manager --enable epel
sudo yum install gdal-python
sudo yum -y install make automake gcc gcc-c++ libcurl-devel proj-devel geos-devel

johnbaums

# Fill nodata within n x n cell window of cells that have data.
# Note that this can result in blocks n x n homogeneous blocks 
# of a particular value extending out from a corner.

library(raster)
library(magrittr)

n <- 5 # width and height of window (in cells)
# note that n = 5 means that cells within 2 cells of a data cell
# will be affected (think of the focal cell as being in the middle

johnbaums

cellBoundaries <- function(r, spatial=TRUE) {
  # r: a Raster object
  # spatial: return an sfc object (TRUE) or a list of extents (FALSE)
  require(raster)
  if(isTRUE(spatial)) require(sf)
  ee <- lapply(seq_along(r), function(i) {
    cat(sprintf('\r%0.2f%%', 100*i/ncell(r)))
    e <- extentFromCells(r, i)
    if(isTRUE(spatial)) {
      e <- st_as_sfc(st_bbox(e))

johnbaums

fastCellFromPolygon <- function(r, p, layer, xy=FALSE, where, precision=0.1, normalizeWeights=FALSE) {
  # r: a Raster* object defining cell arrangement, or path to a raster file.
  # p: file path to a polygon vector dataset.
  # layer: Name of layer to use. Ignored if datasource has only one layer.
  # xy: should xy coordinates be returned? (default = FALSE, cell numbers are returned)
  # where: optional SQL style WHERE statement, e.g. 'where id="123"' (quotes are important).
  # precision: disaggregation factor, multiplicative factor determining
  #   sub-pixel resolution at which to determine cell coverage. For equivalency
  #   with raster::cellFromPolygon, use 0.1.
  # normalizeWeights: should proportional coverage be normalised to sum to 1

johnbaums

get_bionet <- function(x, username, password, outdir, prefix='bionet_',
                       filetype='csv', matchtype='startswith',
                       return_data=FALSE, quiet=FALSE, verbose=FALSE) {
  # x: a vector of species names
  # username, password (optional): credentials for BIONET service
  # outdir: output directory  (must exist)
  # prefix: csv/rds files will be saved in outdir following the pattern
  #         outdir/prefix_Genus_species_yyyymmddHHMMSS.csv/rds
  # filetype: must be one of csv or rds
  # matchtype: must be one of 'startswith', 'contains', or 'equals'.

johnbaums

exdet <- function (ref, p, mic=TRUE, tol, quiet=FALSE) {
# ref: data.frame of environments at reference locations.
  # p: data.frame of environments to assess.
  # mic: should the most influential covariates also be returned?
  # quiet: should messages be suppressed?
  # tol: tolerance, passed to mahalanobis(). See ?solve.
  # =============================================================
  # When passing `mic=TRUE`, a data.frame will be returned with 3 
  #  columns giving the exdet score (D), the most influential
  #  covariate with respect to type 1 novelty (MIC1; equivalent to 

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