https://github.com/cran/spatstat
Raw File
Tip revision: 07a978966c1fa51f9be1df78ac71e335c091bb7a authored by Adrian Baddeley on 10 May 2005, 15:21:58 UTC
version 1.6-6
Tip revision: 07a9789
plot.fv.R
#
#       plot.fv.R   (was: conspire.S)
#
#  $Revision: 1.8 $    $Date: 2005/02/08 01:52:32 $
#
#

conspire <- function(...) {
  .Deprecated("plot.fv")
  plot.fv(...)
}

plot.fv <- function(x, fmla, subset=NULL, lty=NULL, col=NULL,
                     xlim, ylim, xlab, ylab, ...) {

  verifyclass(x, "fv")
  indata <- as.data.frame(x)

  defaultplot <- missing(fmla)
  if(defaultplot)
    fmla <- attr(x, "fmla")

  # This *is* the last possible moment, so...
  fmla <- as.formula(fmla)

  lhs <- fmla[[2]]
  rhs <- fmla[[3]]

  # evaluate expression a in data frame b
  evaluate <- function(a,b) {
    if(exists("is.R") && is.R())
      eval(a, envir=b)
    else
      eval(a, local=b)
  }
  
  lhsdata <- evaluate(lhs, indata)
  rhsdata <- evaluate(rhs, indata)
  
  if(is.vector(lhsdata))
    lhsdata <- matrix(lhsdata, ncol=1)

  if(!is.vector(rhsdata))
    stop("rhs of formula seems not to be a vector")

  # restrict data to subset if desired
  if(!is.null(subset)) {
    keep <- if(is.character(subset))
		evaluate(parse(text=subset), indata)
            else
                evaluate(subset, indata)
    lhsdata <- lhsdata[keep, , drop=FALSE]
    rhsdata <- rhsdata[keep]
  } 

  # determine x and y limits and clip data to these limits
  if(!missing(xlim)) {
    ok <- (xlim[1] <= rhsdata & rhsdata <= xlim[2])
    rhsdata <- rhsdata[ok]
    lhsdata <- lhsdata[ok, , drop=FALSE]
  } else {
    # if we're using the default argument, use its recommended range
    if(rhs == attr(x, "argu")) {
      xlim <- attr(x,"alim")
      ok <- is.finite(rhsdata) & rhsdata >= xlim[1] & rhsdata <= xlim[2]
      rhsdata <- rhsdata[ok]
      lhsdata <- lhsdata[ok, , drop=FALSE]
    } else { # actual range of values to be plotted
      xlim <- range(rhsdata[is.finite(rhsdata)],na.rm=TRUE)
      rok <- is.finite(rhsdata) & rhsdata >= xlim[1] & rhsdata <= xlim[2]
      lok <- apply(is.finite(lhsdata), 1, any)
      ok <- lok & rok
      rhsdata <- rhsdata[ok]
      lhsdata <- lhsdata[ok, , drop=FALSE]
      xlim <- range(rhsdata)
    }
  }
  
  if(missing(ylim))
    ylim <- range(lhsdata,na.rm=TRUE)

  # work out how to label the plot
  if(missing(xlab))
    xlab <- as.character(fmla)[3]

  if(missing(ylab)) {
    yl <- attr(x, "ylab")
    if(!is.null(yl) && defaultplot)
      ylab <- yl
    else {
      yname <- paste(lhs)
      if(length(yname) > 1 && yname[[1]] == "cbind")
        ylab <- paste(yname[-1], collapse=" , ")
      else
        ylab <- as.character(fmla)[2]
    }
  }

  # check for argument "add"=TRUE
  dotargs <- list(...)
  v <- match("add", names(dotargs))
  if(is.na(v) || !(addit <- as.logical(dotargs[[v]])))
    plot(xlim, ylim, type="n", xlab=xlab, ylab=ylab, ...)

  nplots <- ncol(lhsdata)

  if(is.null(lty))
    lty <- 1:nplots
  else if(length(lty) == 1)
    lty <- rep(lty, nplots)
  else if(length(lty) != nplots)
    stop("Length of \`lty\' does not match number of curves to be plotted")
  
  if(is.null(col))
    col <- 1:nplots
  else if(length(col) == 1)
    col <- rep(col, nplots)
  else if(length(col) != nplots)
    stop("Length of \`col\' does not match number of curves to be plotted")
  
  for(i in 1:nplots)
    lines(rhsdata, lhsdata[,i], lty=lty[i], col=col[i])

  if(nplots == 1)
    return(invisible(NULL))
  else 
    return(data.frame(lty=lty, col=col, row.names=colnames(lhsdata)))
}


back to top