https://github.com/cran/spatstat
Raw File
Tip revision: cafe44bc92f43d76e5721c3a261ec282ec0fe1b1 authored by Adrian Baddeley on 05 November 2010, 20:03:15 UTC
version 1.21-0
Tip revision: cafe44b
psp2pix.R
#
# psp2pix.R
#
#  $Revision: 1.5 $  $Date: 2010/03/08 08:23:04 $
#
#

as.mask.psp <- function(x, W=NULL, ...) {
  L <- as.psp(x)
  if(is.null(W))
    W <- as.owin(L)
  else
    W <- as.owin(W)
  W <- as.mask(W, ...)

  ends <- L$ends
  nseg <- nrow(ends)
  
  if(nseg == 0) {
    # empty
    W$m[] <- FALSE
    return(W)
  }
    
  x0 <- (ends$x0 - W$xrange[1])/W$xstep
  x1 <- (ends$x1 - W$xrange[1])/W$xstep
  y0 <- (ends$y0 - W$yrange[1])/W$ystep
  y1 <- (ends$y1 - W$yrange[1])/W$ystep
  nr <- W$dim[1]
  nc <- W$dim[2]
  out <- integer(nr * nc)
  zz <- .C("seg2pixI",
           ns=as.integer(nseg),
           x0=as.double(x0),
           y0=as.double(y0),
           x1=as.double(x1),
           y1=as.double(y1),
           nx=as.integer(nc),
           ny=as.integer(nr),
           out=as.integer(out),
           PACKAGE="spatstat")
  mm <- matrix(zz$out, nr, nc)
  # intersect with existing window
  W$m <- W$m & mm
  W
}


pixellate.psp <- function(x, W=NULL, ..., weights=NULL) {
  L <- as.psp(x)
  if(is.null(W))
    W <- as.owin(L)
  else
    W <- as.owin(W)
  W <- as.mask(W, ...)

  Z <- as.im(W)

  ends <- L$ends
  nseg <- nrow(ends)

  if(nseg == 0) {
    # empty
    Z$v[] <- 0
    return(Z)
  }
  
  if(is.null(weights))
    weights <- rep(1, nseg)
  else {
    if(!is.numeric(weights)) stop("weights must be numeric")
    if(any(is.na(weights))) stop("weights must not be NA")
    if(!all(is.finite(weights))) stop("weights must not be infinite")
    if(length(weights) == 1)
      weights <- rep(weights, nseg)
    else if(length(weights) != nseg)
      stop(paste("weights vector has length", length(weights),
                 "but there are", nseg, "line segments"))
  }
      
  x0 <- (ends$x0 - Z$xrange[1])/Z$xstep
  x1 <- (ends$x1 - Z$xrange[1])/Z$xstep
  y0 <- (ends$y0 - Z$yrange[1])/Z$ystep
  y1 <- (ends$y1 - Z$yrange[1])/Z$ystep
  nr <- Z$dim[1]
  nc <- Z$dim[2]
  zz <- .C("seg2pixL",
           ns=as.integer(nseg),
           x0=as.double(x0),
           y0=as.double(y0),
           x1=as.double(x1),
           y1=as.double(y1),
           weights=as.double(weights),
           pixwidth=as.double(Z$xstep),
           pixheight=as.double(Z$ystep),
           nx=as.integer(nc),
           ny=as.integer(nr),
           out=as.double(numeric(nr * nc)),
           PACKAGE="spatstat")
  mm <- matrix(zz$out, nr, nc)
  mm[is.na(Z$v)] <- NA
  # intersect with existing window
  Z$v <- mm
  Z
}


back to top