Raw File
edgeTrans.R
#
#        edgeTrans.R
#
#    $Revision: 1.6 $    $Date: 2004/11/27 05:47:39 $
#
#    Translation edge correction weights
#
#  edge.Trans(X)      compute translation correction weights
#                     for each pair of points from point pattern X 
#
#  edge.Trans(X, Y, W)   compute translation correction weights
#                        for all pairs of points X[i] and Y[j]
#                        (i.e. one point from X and one from Y)
#                        in window W
#
#  To estimate the K-function see the idiom in "Kest.S"
#
#######################################################################

edge.Trans <- function(X, Y=X, W=X$window, exact=FALSE,
                       trim=spatstat.options("maxedgewt")[[1]]) {

  X <- as.ppp(X, W)

  W <- X$window
  x <- X$x
  y <- X$y

  Y <- as.ppp(Y, W)
  xx <- Y$x
  yy <- Y$y
  
  # For irregular polygons, exact evaluation is very slow;
  # so use pixel approximation, unless exact=TRUE
  if(W$type == "polygonal" && !exact)
    W <- as.mask(W)

  switch(W$type,
         rectangle={
           # Fast code for this case
           wide <- diff(W$xrange)
           high <- diff(W$yrange)
           DX <- abs(outer(x,xx,"-"))
           DY <- abs(outer(y,yy,"-"))
           weight <- wide * high / ((wide - DX) * (high - DY))
         },
         polygonal={
           # This code is SLOW
           a <- area.owin(W)
           weight <- matrix(, nrow=X$n, ncol=Y$n)
           for(i in seq(X$n)) {
             for(j in seq(Y$n)) {
               shiftvector <- c(x[i],y[i]) - c(xx[j],yy[j])
               Wshift <- shift(W, shiftvector)
               b <- overlap.owin(W, Wshift)
               weight[i,j] <- a/b
             }
           }
         },
         mask={
           # make difference vectors
           DX <- outer(x,xx,"-")
           DY <- outer(y,yy,"-")
           # compute set covariance of window
           g <- setcov(W)
           # evaluate set covariance at these vectors
           gvalues <- lookup.im(g, as.vector(DX), as.vector(DY), naok=TRUE)
           # reshape
           gvalues <- matrix(gvalues, nrow=X$n, ncol=Y$n)
           weight <- area.owin(W)/gvalues
         }
         )
  weight <- matrix(pmin(weight, trim), nrow=X$n, ncol=Y$n)
  return(weight)
}
back to top