bivariate raster plots in R - r

Question

I have challenge in plotting a bivariate raster data in one plot with one legend for both variables. my first layer is a continuous variable ranging between -2 and 2 while the second layer is a categorical variable (in years form 1980 to 2011). I need help in ploting the data as one rastr plot with a color scheme and legend which shows both variables as shown here. I appreciate your help.
r <- raster(ncols=100, nrows=100)
r[] <- runif(ncell(r))
crs(r) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
r1 <- raster(ncols=100, nrows=100)
r1[] <- 1980:2011
crs(r1) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
dta=stack(r,r1)

Answer 1

See ?raster::plot for examples, or do spplot(dta)

Answer 2

I successfully applied the code from the site you mentioned.
kpacks <- c("classInt", 'raster', 'rgdal',
'dismo', 'XML', 'maps', 'sp')
new.packs <- kpacks[!(kpacks %in% installed.packages()[, "Package"])]
if (length(new.packs))
install.packages(new.packs)
lapply(kpacks, require, character.only = T)
remove(kpacks, new.packs)
r <- raster(ncols = 100, nrows = 100)
r[] <- runif(ncell(r))
crs(r) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
r1 <- raster(ncols = 100, nrows = 100)
r1[] <- sample(1980:2011, 10000, replace = T)
crs(r1) <- "+proj=lcc +lat_1=48 +lat_2=33 +lon_0=-100 +ellps=WGS84"
dta = stack(r, r1)
plot(dta)
colmat <-
function(nquantiles = 10,
upperleft = rgb(0, 150, 235, maxColorValue = 255),
upperright = rgb(130, 0, 80, maxColorValue = 255),
bottomleft = "grey",
bottomright = rgb(255, 230, 15, maxColorValue = 255),
xlab = "x label",
ylab = "y label") {
my.data <- seq(0, 1, .01)
my.class <- classIntervals(my.data, n = nquantiles, style = "quantile")
my.pal.1 <- findColours(my.class, c(upperleft, bottomleft))
my.pal.2 <- findColours(my.class, c(upperright, bottomright))
col.matrix <- matrix(nrow = 101, ncol = 101, NA)
for (i in 1:101) {
my.col <- c(paste(my.pal.1[i]), paste(my.pal.2[i]))
col.matrix[102 - i, ] <- findColours(my.class, my.col)
}
plot(
c(1, 1),
pch = 19,
col = my.pal.1,
cex = 0.5,
xlim = c(0, 1),
ylim = c(0, 1),
frame.plot = F,
xlab = xlab,
ylab = ylab,
cex.lab = 1.3
)
for (i in 1:101) {
col.temp <- col.matrix[i - 1, ]
points(
my.data,
rep((i - 1) / 100, 101),
pch = 15,
col = col.temp,
cex = 1
)
}
seqs <- seq(0, 100, (100 / nquantiles))
seqs[1] <- 1
col.matrix <- col.matrix[c(seqs), c(seqs)]
}
col.matrix <-
colmat(
nquantiles = 10,
upperleft = "blue",
upperright = "yellow",
bottomleft = "green",
bottomright = "red",
xlab = "My x label",
ylab = "My y label"
)
bivariate.map <-
function(rasterx,
rastery,
colormatrix = col.matrix,
nquantiles = 10) {
quanmean <- getValues(rasterx)
temp <- data.frame(quanmean, quantile = rep(NA, length(quanmean)))
brks <-
with(temp, quantile(temp, na.rm = TRUE, probs = c(seq(0, 1, 1 / nquantiles))))
r1 <-
within(
temp,
quantile <-
cut(
quanmean,
breaks = brks,
labels = 2:length(brks),
include.lowest = TRUE
)
)
quantr <- data.frame(r1[, 2])
quanvar <- getValues(rastery)
temp <- data.frame(quanvar, quantile = rep(NA, length(quanvar)))
brks <-
with(temp, quantile(temp, na.rm = TRUE, probs = c(seq(0, 1, 1 / nquantiles))))
r2 <-
within(temp,
quantile <-
cut(
quanvar,
breaks = brks,
labels = 2:length(brks),
include.lowest = TRUE
))
quantr2 <- data.frame(r2[, 2])
as.numeric.factor <- function(x) {
as.numeric(levels(x))[x]
}
col.matrix2 <- colormatrix
cn <- unique(colormatrix)
for (i in 1:length(col.matrix2)) {
ifelse(is.na(col.matrix2[i]),
col.matrix2[i] <- 1,
col.matrix2[i] <- which(col.matrix2[i] == cn)[1])
}
cols <- numeric(length(quantr[, 1]))
for (i in 1:length(quantr[, 1])) {
a <- as.numeric.factor(quantr[i, 1])
b <- as.numeric.factor(quantr2[i, 1])
cols[i] <- as.numeric(col.matrix2[b, a])
}
r <- rasterx
r[1:length(r)] <- cols
return(r)
}
my.colors = colorRampPalette(c("white", "lightblue", "yellow", "orangered", "red"))
plot(
r,
frame.plot = F,
axes = F,
box = F,
add = F,
legend.width = 1,
legend.shrink = 1,
col = my.colors(255)
)
map(interior = T, add = T)
bivmap <- bivariate.map(r, r1, colormatrix = col.matrix, nquantiles = 10)
# Plot the bivariate map:
plot(
bivmap,
frame.plot = F,
axes = F,
box = F,
add = F,
legend = F,
col = as.vector(col.matrix)
)
col.matrix