https://github.com/cran/spatstat
Raw File
Tip revision: 80e2bf6554e41a2e631d507470867f9586310633 authored by Adrian Baddeley on 10 January 2019, 15:30:04 UTC
version 1.58-2
Tip revision: 80e2bf6
is.subset.owin.R
#
#  is.subset.owin.R
#
#  $Revision: 1.14 $   $Date: 2017/02/07 07:47:20 $
#
#  Determine whether a window is a subset of another window
#
#  is.subset.owin()
#

is.subset.owin <- local({
  
  is.subset.owin <- function(A, B) {
    A <- as.owin(A)
    B <- as.owin(B)

    if(identical(A, B))
      return(TRUE)

    A <- rescue.rectangle(A)
    B <- rescue.rectangle(B)
  
    if(is.rectangle(B)) {
      # Some cases can be resolved using convexity of B
    
      # (1) A is also a rectangle
      if(is.rectangle(A)) {
        xx <- A$xrange[c(1L,2L,2L,1L)]
        yy <- A$yrange[c(1L,1L,2L,2L)]
        ok <- inside.owin(xx, yy, B)
        return(all(ok))
      } 
      # (2) A is polygonal
      # Then A is a subset of B iff,
      # for every constituent polygon of A with positive sign,
      # the vertices are all in B
      if(is.polygonal(A)) {
        ok <- unlist(lapply(A$bdry, okpolygon, B=B))
        return(all(ok))
      }
      # (3) Feeling lucky
      # Test whether the bounding box of A is a subset of B
      # Then a fortiori, A is a subset of B
      AA <- boundingbox(A)
      if(is.subset.owin(AA, B))
        return(TRUE)
    }

    if(!is.mask(A) && !is.mask(B)) {
      # rectangles or polygonal domains
      if(!all(inside.owin(vertices(A), , B)))
        return(FALSE)
      # all vertices of A are inside B.
      if(is.convex(B))
        return(TRUE)
      A <- as.polygonal(A)
      B <- as.polygonal(B)
      if(length(B$bdry) == 1 && length(A$bdry) == 1) {
        # two simply-connected sets 
        # check for boundary crossings
        bx <- crossing.psp(edges(A), edges(B))
        return(npoints(bx) == 0)
      } else {
        # compare area of intersection with area of A
        return(overlap.owin(A,B) >= area(A))
      }
    }
  
   # Discretise
    a <- as.mask(A)
    b <- as.mask(B)
    rxy <- rasterxy.mask(a, drop=TRUE)
    xx <- rxy$x
    yy <- rxy$y
    ok <- inside.owin(xx, yy, b)
    return(all(ok))
    
  }

  okpolygon <- function(a, B) {
    if(Area.xypolygon(a) < 0) return(TRUE)
    ok <- inside.owin(a$x, a$y, B)
    return(all(ok))
  }

  is.subset.owin
})
back to top