https://github.com/cran/spatstat
Raw File
Tip revision: a4d492aa61e9788b29dbb5ca1b346c6eaa60ca95 authored by Adrian Baddeley on 29 February 2012, 13:06:31 UTC
version 1.25-4
Tip revision: a4d492a
plot.splitppp.R
#
plot.listof <- plot.splitppp <- function(x, ..., main, arrange=TRUE,
                                         nrows=NULL, ncols=NULL,
                                         main.panel=NULL,
                                         mar.panel=c(2,1,1,2),
                                         panel.begin=NULL,
                                         panel.end=NULL,
                                         panel.args=NULL,
                                         plotcommand="plot") {
  xname <- deparse(substitute(x))
  n <- length(x)
  names(x) <- good.names(names(x), "Component_", 1:n)
  if(is.null(main.panel))
    main.panel <- names(x)
  else {
    stopifnot(is.character(main.panel) || is.expression(main.panel))
    nmp <- length(main.panel)
    if(nmp == 1)
      main.panel <- rep(main.panel, n)
    else if(nmp != n)
      stop("Incorrect length for main.panel")
  }

  extraplot <- function(nnn, ..., panel.args=NULL, plotcommand="plot") {
    if(is.null(panel.args)) {
      do.call(plotcommand, list(...))
    } else {
      xtra <- if(is.function(panel.args)) panel.args(nnn) else panel.args
      if(!is.list(xtra)) stop("panel.args should be a list")
      do.call(plotcommand, append(list(...), xtra))
    }
  }

  exec.or.plot <- function(x, i, ...) {
    if(is.null(x)) return(NULL)
    if(is.function(x)) x(i) else plot(x, ...)
  }
  
  if(!arrange) {
    for(i in 1:n) {
      exec.or.plot(panel.begin, i, main=main.panel[i])
      extraplot(i, x[[i]], ...,
                add=!is.null(panel.begin),
                main=main.panel[i],
                panel.args=panel.args, plotcommand=plotcommand)
      exec.or.plot(panel.end, i, add=TRUE)
    }
    return(invisible(NULL))
  }

  # decide whether to plot a main header
  main <- if(!missing(main)) main else xname
  if(!is.character(main)) {
    # main title could be an expression
    nlines <- 1
    banner <- TRUE
  } else {
    # main title is character string/vector, possibly ""
    banner <- any(nzchar(main))
    if(length(main) > 1)
      main <- paste(main, collapse="\n")
    nlines <- length(unlist(strsplit(main, "\n")))
  }
  # determine arrangement of plots
  # arrange like mfrow(nrows, ncols) plus a banner at the top
  if(is.null(nrows) && is.null(ncols)) {
    nrows <- as.integer(floor(sqrt(n)))
    ncols <- as.integer(ceiling(n/nrows))
  } else if(!is.null(nrows) && is.null(ncols))
    ncols <- as.integer(ceiling(n/nrows))
  else if(is.null(nrows) && !is.null(ncols))
    nrows <- as.integer(ceiling(n/ncols))
  else stopifnot(nrows * ncols >= length(x))
  nblank <- ncols * nrows - n
  # declare layout
  mat <- matrix(c(seq_len(n), rep(0, nblank)),
                byrow=TRUE, ncol=ncols, nrow=nrows)
  heights <- rep(1, nrows)
  if(banner) {
    # Increment existing panel numbers
    # New panel 1 is the banner
    panels <- (mat > 0)
    mat[panels] <- mat[panels] + 1
    mat <- rbind(rep(1,ncols), mat)
    heights <- c(0.1 * (1 + nlines), heights)
  }
  layout(mat, heights=heights)
  # plot banner
  if(banner) {
    opa <- par(mar=rep(0,4), xpd=TRUE)
    plot(numeric(0),numeric(0),type="n",ann=FALSE,axes=FALSE,
         xlim=c(-1,1),ylim=c(-1,1))
    cex <- resolve.defaults(list(...), list(cex.title=2))$cex.title
    text(0,0,main, cex=cex)
  }
  # plot panels
  npa <- par(mar=mar.panel)
  if(!banner) opa <- npa
  for(i in 1:n) {
    exec.or.plot(panel.begin, i, main=main.panel[i])
    extraplot(i, x[[i]], ...,
              add = !is.null(panel.begin), 
              main = main.panel[i],
              panel.args=panel.args, plotcommand=plotcommand)
    exec.or.plot(panel.end, i, add=TRUE)
  }
  # revert
  layout(1)
  par(opa)
  return(invisible(NULL))
}
  
density.splitppp <- function(x, ...) {
  as.listof(lapply(x, density, ...))
}
back to top