Skip to content

Instantly share code, notes, and snippets.

View johnbaums's full-sized avatar

John johnbaums

  • University of Melbourne
  • Melbourne
View GitHub Profile
@johnbaums
johnbaums / levelplot_second_colorkey.R
Created May 23, 2019 03:52
Plot a second colorkey using levelplot and grid graphics in R
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
johnbaums / ramp.R
Last active May 15, 2019 04:51
Generate colour vectors with defined colour transitions and specified number of colours
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
johnbaums / flip_legend.R
Last active October 23, 2019 00:45
Vertically flip a mapview or leaflet legend
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
johnbaums / exdet.R
Last active June 12, 2019 02:34
Faster extrapolation detection (ExDet) based on ecospat::ecospat.climan
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
johnbaums / hexToChar.R
Last active February 6, 2019 04:29
Convert a hexadecimal string representation to character
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
johnbaums / get_cmip5.R
Last active February 27, 2019 03:45
Get anomalies from CMIP5 climate change projections, based on the interface at https://www.climatechangeinaustralia.gov.au/en/climate-projections/explore-data/data-download/gridded-data-download/
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
johnbaums / add_transparency.R
Last active August 4, 2018 05:47
Plot a raster, modified by a second raster indicating transparency
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
johnbaums / hatch.R
Last active July 12, 2021 03:27
Create hatched SpatialLines or sf object from SpatialPolygons* or sf (multi)polygon
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
johnbaums / gdal_weightedmean.R
Created February 26, 2018 00:06
Fast calculation of cellwise mean across a raster stack, using gdal_calc.py
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?
@johnbaums
johnbaums / rast_sd.R
Created October 30, 2017 23:57
Faster standard deviation of RasterStack objects
rast_sd <- function(x) {
# x: a RasterStack
n <- nlayers(x)
m <- mean(x)
devsq <- (x - m)^2
sqrt(sum(devsq)/(n-1))
}