https://github.com/cran/spatstat
Raw File
Tip revision: 4b1b757a8dfaf6fa6dfb3d3e862aeb2abdfe4f00 authored by Adrian Baddeley on 27 July 2009, 19:54:06 UTC
version 1.16-1
Tip revision: 4b1b757
rescue.rectangle.R
#
#    rescue.rectangle.R
# 
#    $Revision: 1.6 $   $Date: 2008/06/15 14:53:11 $
#
rescue.rectangle <- function(W) {
  verifyclass(W, "owin")

  if(W$type == "mask" && all(W$m))
     return(owin(W$xrange, W$yrange, unitname=unitname(W)))

  if(W$type == "polygonal" && length(W$bdry) == 1) {
    x <- W$bdry[[1]]$x
    y <- W$bdry[[1]]$y
    if(length(x) == 4 && length(y) == 4) {
      # could be a rectangle
      veryunique <- function(z) {
        uz <- sort(unique(z))
        epsilon <- 2 * .Machine$double.eps * diff(range(uz))
        close <- (diff(uz) <= epsilon)
        uz <- uz[c(TRUE, !close)]
        return(uz)
      }
      ux <- veryunique(x)
      uy <- veryunique(y)
      if(length(ux) == 2 && length(uy) == 2)
        return(owin(ux,uy, unitname=unitname(W)))
    }
  }
  
  return(W)
}

back to top