Raw File
distfun.R
#
#   distfun.R
#
#   distance function (returns a function of x,y)
#
#   $Revision: 1.3 $   $Date: 2010/04/07 08:04:59 $
#

distfun <- function(X, ...) {
  UseMethod("distfun")
}

distfun.ppp <- function(X, ...) {
  # this line forces X to be bound
  stopifnot(is.ppp(X))
  g <- function(x,y) {
    Y <- if(!missing(y)) ppp(x, y, window=X$window) else as.ppp(x)
    nncross(Y, X)$dist
  }
  attr(g, "Xclass") <- "ppp"
  class(g) <- c("distfun", class(g))
  return(g)
}

distfun.psp <- function(X, ...) {
  # this line forces X to be bound
  stopifnot(is.psp(X))
  g <- function(x,y) {
    Y <- if(!missing(y)) ppp(x, y, window=X$window) else as.ppp(x)
    nncross(Y, X)$dist
  }
  attr(g, "Xclass") <- "psp"
  class(g) <- c("distfun", class(g))
  return(g)
}

distfun.owin <- function(X, ..., invert=FALSE) {
  # this line forces X to be bound
  stopifnot(is.owin(X))
  P <- as.psp(as.polygonal(X))
  R <- as.rectangle(X)
  g <- function(x,y) {
    if(missing(y)) {
      Y <- as.ppp(x)
      x <- Y$x
      y <- Y$y
    }
    inside <- inside.owin(x, y, X)
    D <- nncross(list(x=x,y=y), P)$dist
    zero <- if(!invert) inside else !inside
    out <- ifelse(zero, 0, D)
    return(out)
  }
  attr(g, "Xclass") <- "owin"
  class(g) <- c("distfun", class(g))
  return(g)
}

print.distfun <- function(x, ...) {
  xtype <- attr(x, "Xclass")
  typestring <- switch(xtype,
                       ppp="point pattern",
                       psp="line segment pattern",
                       owin="window",
                       "unrecognised object")
  cat(paste("Distance function for", typestring, "\n"))
  X <- get("X", envir=environment(x))
  print(X)
  return(invisible(NULL))
}

plot.distfun <- function(x, ...) {
  xname <- deparse(substitute(x))
  X <- get("X", envir=environment(x))
  Z <- as.im(x, as.rectangle(X))
  do.call("plot",
          resolve.defaults(list(Z),
                           list(...),
                           list(main=xname)))
}

as.owin.distfun <- function(W, ..., fatal=TRUE) {
  X <- get("X", envir=environment(W))
  as.owin(X, ..., fatal=fatal)
}
back to top