Raw File
smoothfun.R
##
## smoothfun.R
##
## Exact 'funxy' counterpart of Smooth.ppp
##
##  $Revision: 1.1 $ $Date: 2014/04/04 03:04:08 $


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

Smoothfun.ppp <- function(X, sigma=NULL, ...,
                          weights=NULL, edge=TRUE, diggle=FALSE) {
  verifyclass(X, "ppp")
  if(!is.marked(X, dfok=TRUE))
    stop("X should be a marked point pattern")
  stuff <- list(X=X, weights=weights, edge=edge, diggle=diggle)
  X <- coerce.marks.numeric(X)
  ## determine smoothing parameters
  ker <- resolve.2D.kernel(sigma=sigma, ...,
                           x=X, bwfun=bw.smoothppp, allow.zero=TRUE)
  stuff <- append(stuff, ker[c("sigma", "varcov")])
  ##
  g <- function(x, y=NULL) {
    Y <- xy.coords(x, y)[c("x", "y")]
    with(stuff,
         smoothcrossEngine(Xdata=X,
                           Xquery=as.ppp(Y, X$window),
                           values=marks(X),
                           sigma=sigma,
                           varcov=varcov, 
                           weights=weights,
                           edge=edge, diggle=diggle))
  }
  g <- funxy(g, as.rectangle(as.owin(X)))
  class(g) <- c("Smoothfun", class(g))
  return(g)
}

print.Smoothfun <- function(x, ...) {
  cat("function(x,y)", "which returns",
      "values", "interpolated from", fill=TRUE)
  X <- get("X", envir=environment(x))
  print(X, ...)
  return(invisible(NULL))
}

## Method for as.im
## (enables plot.funxy, persp.funxy, contour.funxy to work for this class)

as.im.Smoothfun <- function(X, W=NULL, ...) {
  stuff <- get("stuff", envir=environment(X))
  if(!is.null(W)) stuff$X <- stuff$X[W]
  do.call("Smooth", resolve.defaults(list(...), stuff))
}


  
back to top