https://github.com/cran/spatstat
Tip revision: 4712eff0e57ddd871eee94f8a5fd24be181fdf44 authored by Adrian Baddeley on 17 January 2013, 07:33:07 UTC
version 1.31-0
version 1.31-0
Tip revision: 4712eff
layered.R
#
# layered.R
#
# Simple mechanism for layered plotting
#
# $Revision: 1.1 $ $Date: 2011/09/01 04:11:32 $
#
layered <- function(..., plotargs=NULL) {
out <- list(...)
if(!is.null(plotargs)) {
if(!is.list(plotargs) || !all(unlist(lapply(plotargs, is.list))))
stop("plotargs should be a list of lists")
if(length(plotargs) != length(out))
stop("plotargs should have one component for each element of the list")
names(plotargs) <- names(out)
}
attr(out, "plotargs") <- plotargs
class(out) <- c("layered", class(out))
return(out)
}
print.layered <- function(x, ...) {
cat("Layered object\n")
for(i in seq_along(x)) {
cat(paste("\nLayer ", i, ":\n", sep=""))
print(x[[i]])
}
invisible(NULL)
}
plot.layered <- function(x, ..., which=NULL, plotargs=NULL) {
xname <- short.deparse(substitute(x))
xp <- if(is.null(which)) x else x[which]
if(length(xp) == 0)
return(invisible(NULL))
if(is.null(plotargs)) {
plotargs <- attr(x, "plotargs")
if(!is.null(plotargs) && !is.null(which)) plotargs <- plotargs[which]
} else {
if(!is.list(plotargs) || !all(unlist(lapply(plotargs, is.list))))
stop("plotargs should be a list of lists")
if(length(plotargs) != length(xp))
stop("plotargs should have one component for each layer to be plotted")
}
out <- list()
for(i in seq_along(xp)) {
first <- (i == 1)
out[[i]] <-
do.call("plot",
resolve.defaults(list(x=xp[[i]]),
plotargs[[i]],
list(...),
if(first) list(main=xname) else list(add=TRUE)))
}
return(invisible(out))
}