Add hatching functionality to map functions
The current map plotting functions don't have the hatching feature. Here is a script to add hatching over a map from @vtorralba (not sure if it is the most updated version; if not, please help us update it, thanks!) It should work with VizEquiMap() but not other projections.
hatching<-function(lats, lons, mask, dens = 10, ang = 45, col_line = '#252525',
lwd_size = 0.5, crosshatching =FALSE) {
# Function to add a mask over the maps
# July 2016. Veronica Torralba
# Arguments:
# ~~~~~~~~
# lats: Array of latitudes.
# lons: Array of longitudes.
# mask: matrix with dimensions (longitud x latitud)
# dens: the density of shading lines, in lines per inch. The default value of NULL means that no shading lines are drawn.
# A zero value of density means no shading nor filling whereas negative values and NA suppress shading (and so allow color filling).
# ang: the slope of shading lines, given as an angle in degrees (counter-clockwise).
# col_line: colour of the lines
# lwd_size: The line width, a positive number, defaulting to 1. The interpretation is device-specific, and some devices
# do not implement line widths less than one.
# crosshatching: T/F if crosshatching instead of diagonal lines.
if (length(dim(mask))!= 2){
stop('The mask matrix should have longitude x latitude dimensions')
}
if (dim(mask)[1]!=length(lons)| dim(mask)[2]!=length(lats)){
stop('The mask matrix should have longitude x latitude dimensions')
}
# Function from www.menugget.blogspot.com
# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
matrix.poly <- function(x, y, z = mat, n = NULL) {
if (missing(z))
stop("Must define matrix 'z'")
if (missing(n))
stop("Must define at least 1 grid location 'n'")
if (missing(x))
x <- seq(0,1,,dim(z)[1])
if (missing(y))
y <- seq(0,1,,dim(z)[2])
poly <- vector(mode = "list", length(n))
for (i in seq(n)) {
ROW <- ((n[i] - 1) %% dim(z)[1]) + 1
COL <- ((n[i] - 1) %/% dim(z)[1]) + 1
dist.left <- (x[ROW] - x[ROW - 1]) / 2
dist.right <- (x[ROW + 1] - x[ROW]) / 2
if (ROW == 1)
dist.left <- dist.right
if (ROW == dim(z)[1])
dist.right <- dist.left
dist.down <- (y[COL] - y[COL - 1]) / 2
dist.up <- (y[COL + 1] - y[COL]) / 2
if (COL == 1)
dist.down <- dist.up
if (COL == dim(z)[2])
dist.up <- dist.down
xs <-
c(x[ROW] - dist.left, x[ROW] - dist.left, x[ROW] + dist.right, x[ROW] +
dist.right)
ys <-
c(y[COL] - dist.down, y[COL] + dist.up, y[COL] + dist.up, y[COL] - dist.down)
poly[[i]] <- data.frame(x = xs, y = ys)
}
return(poly)
}
M <- list(x = lons, y = lats, z = mask)
incl <- which(M$z ==TRUE)
polys <- matrix.poly(M$x, M$y, z = M$z, n = incl)
for (i in seq(polys)) {
polygon( polys[[i]], density = dens, angle = ang, border = NA, lwd = lwd_size,col=col_line)
if (crosshatching) {
polygon(polys[[i]], density = dens, angle = -ang, border = NA, lwd = lwd_size, col=col_line)
}
}
}