imap <- function (longlat = list(world.h.land, world.h.lake, world.h.island, world.h.pond.in.island, world.h.borders),
longrange, latrange, zoom = TRUE, col= c("black", "blue", "forestgreen", "dodgerblue", "cyan"), fill = TRUE,
poly = c("grey40", "blue", "forestgreen", "dodgerblue", NA), lwd = 1, keep.attr = TRUE, add.all = FALSE, bg = "grey81",
tol = 0.05, cex.xlab = 1, cex.ylab = 1, cex.axis = 1, lwd.ticks = 1, ...)
{
par(bg = bg)
if (is.matrix(longlat) | is.data.frame(longlat)) {
LongLat <- longlat
longlat <- list()
longlat[[1]] <- list(ll=as.matrix(LongLat), col = col[1], lwd = lwd[1], poly=poly[1])
rm(LongLat)
}
if (!is.list(longlat[[1]])) {
N <- length(longlat)
col <- rep(col, length = N)
lwd <- rep(lwd, length = N)
poly <- rep(poly, length = N)
LongLat <- longlat
longlat <- list()
for(i in 1:N)
longlat[[i]] <- list(ll = LongLat[[i]], col=col[i], lwd=lwd[i], poly = poly[i])
rm(LongLat)
} else {
if(!keep.attr) {
N <- length(longlat)
col <- rep(col, length = N)
lwd <- rep(lwd, length = N)
poly <- rep(poly, length = N)
LongLat <- longlat
longlat <- list()
for(i in 1:N)
longlat[[i]] <- list(ll = LongLat[[i]]$ll, col=col[i], lwd=lwd[i], poly = poly[i])
rm(LongLat)
}
}
if (missing(longrange) | missing(latrange)) {
max.ll <- apply(data.frame(lapply(longlat, function(x) apply(x[['ll']],
2, max, na.rm = TRUE))), 1, max)
min.ll <- apply(data.frame(lapply(longlat, function(x) apply(x[['ll']],
2, min, na.rm = TRUE))), 1, min)
}
if (missing(longrange))
longrange <- c(min.ll[1], max.ll[1])
if (missing(latrange))
latrange <- c(min.ll[2], max.ll[2])
ll.out <- list()
for (i in 1:length(longlat)) {
ll.out[[i]] <- list(ll=matrix(
imap.ll(longlat[[i]][['ll']], longrange, latrange, add = ifelse(add.all, TRUE, ifelse(i == 1,
FALSE, TRUE)), zoom = FALSE, col = longlat[[i]][['col']], poly = ifelse(fill, longlat[[i]][['poly']], NA),
lwd = longlat[[i]][['lwd']], cex.xlab = cex.xlab, cex.ylab = cex.ylab, cex.axis = cex.axis, lwd.ticks = lwd.ticks, ...),
ncol = 2), col=longlat[[i]][['col']], lwd=longlat[[i]][['lwd']], poly = longlat[[i]][['poly']])
}
if (zoom) {
if (is.list(c1 <- locator(1))) {
points(c1, pch = 3, cex = 3, col = 2)
points(c2 <- locator(1), pch = 3, cex = 3, col = 2)
if (abs(c1$x - c2$x) < tol & abs(c1$y - c2$y) < tol) {
points(c1, pch = 0, cex = 3, col = 3)
ll.out <- imap(longlat, zoom = TRUE, fill = fill, bg = bg, keep.attr = keep.attr, tol = tol, ...)
}
else ll.out <- imap(longlat, c(c1$x, c2$x), c(c1$y,
c2$y), zoom = TRUE, fill = fill, bg = bg, keep.attr = keep.attr, tol = tol, ...)
}
}
for (i in length(ll.out):1) {
if(all(is.na(ll.out[[i]]$ll)))
ll.out[[i]] <- NULL
}
invisible(ll.out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.