Venn tessellation; new release again

spatstat · Jan 10, 2019 · 0913e78 · 0913e78
1 parent bec17d5
commit 0913e78
Show file tree

Hide file tree

Showing 11 changed files with 151 additions and 23 deletions.
diff --git a/ChangeLogs/ChangeLog1.58-2.txt b/ChangeLogs/ChangeLog1.58-2.txt
@@ -0,0 +1,25 @@
+Change log from 1.58-1 to 1.58-2
+================================
+
+10 jan 2019
+
+   DESCRIPTION
+   NEWS
+   Nickname.txt
+	Version 1.58-2
+	Nickname 'Not Even Wrong'
+
+   tess.R
+   venn.tess.Rd [New file]
+        New function venn.tess
+
+   tess.Rd
+   spatstat-package.Rd
+	Cross-references to venn.tess
+
+   options.R
+	More buglet fixes detected by CRAN
+
+------------- passed R-3.5.2 CMD check ---------------
+------------- installed on laptop      ---------------
+------------- committed to GitHub      ---------------
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: spatstat
-Version: 1.58-1
+Version: 1.58-2
 Date: 2019-01-10
 Title: Spatial Point Pattern Analysis, Model-Fitting, Simulation, Tests
 Author: Adrian Baddeley <Adrian.Baddeley@curtin.edu.au>,

diff --git a/NAMESPACE b/NAMESPACE
@@ -2498,6 +2498,7 @@ export("vcov.mppm")
 export("vcov.ppm")
 export("vcov.slrm")
 export("vdCorput")
+export("venn.tess")
 export("verifyclass")
 export("versionstring.interact")
 export("versionstring.ppm")

diff --git a/NEWS b/NEWS
@@ -1,10 +1,25 @@
 
+        CHANGES IN spatstat VERSION 1.58-2
+
+OVERVIEW
+
+    o Venn diagram tessellation
+
+    o Internal bug fixes.
+
+SIGNIFICANT USER-VISIBLE CHANGES
+
+    o venn.tess
+    Venn diagram tessellation.
+
         CHANGES IN spatstat VERSION 1.58-1
 
 OVERVIEW
 
     o Bug fixes.
 
+    o Version nickname: "Compliment Sandwich"
+
 BUG FIXES
 
     o lpp

diff --git a/R/options.R b/R/options.R
@@ -3,7 +3,7 @@
 #
 #     Spatstat options and other internal states
 #
-#    $Revision: 1.82 $   $Date: 2018/06/08 13:17:02 $
+#    $Revision: 1.83 $   $Date: 2019/01/10 09:11:08 $
 #
 #
 
@@ -143,7 +143,8 @@ warn.once <- function(key, ...) {
          ## maximum size of matrix in dppeigen
          default=2^24, # 16,777,216
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 1024
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x > 1024)
          },
          valid="a single integer, greater than 1024"
        ),
@@ -157,7 +158,7 @@ warn.once <- function(key, ...) {
          ## default area expansion factor
          default=2,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && x > 1
+           is.numeric(x) && length(x) == 1 && all(x > 1)
          },
          valid="a single numeric value, greater than 1"
        ),
@@ -217,7 +218,8 @@ warn.once <- function(key, ...) {
          ## threshold to trigger a warning from rpoispp 
          default=1e6,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 1024
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x > 1024)
          },
          valid="a single integer, greater than 1024"
        ),
@@ -247,15 +249,16 @@ warn.once <- function(key, ...) {
          ## maximum edge correction weight 
          default=100,
          check=function(x){
-           is.numeric(x) && length(x) == 1 && is.finite(x) && x >= 1
+           is.numeric(x) && length(x) == 1 && is.finite(x) && all(x >= 1)
          },
          valid="a finite numeric value, not less than 1"
        ),
        maxmatrix=list(
          ## maximum size of matrix of pairs of points in mpl.R
          default=2^24, # 16,777,216
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 1024
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x > 1024)
          },
          valid="a single integer, greater than 1024"
        ),
@@ -269,7 +272,8 @@ warn.once <- function(key, ...) {
          ## number of values of bandwidth to try in bandwidth selection
          default=32,
          check=function(x) {
-           is.numeric(x) && (length(x) == 1) && (x == ceiling(x)) && (x > 2)
+           is.numeric(x) && (length(x) == 1) &&
+             all(x == ceiling(x)) && all(x > 2)
          },
          valid="a single integer, greater than 2"
        ),
@@ -285,15 +289,15 @@ warn.once <- function(key, ...) {
          ## number of grid points used to calculate area in area-interaction
          default=128,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 1
+           is.numeric(x) && length(x) == 1 && all(x == ceiling(x)) && all(x > 1)
          },
          valid="a single integer, greater than 1"
        ),
        npixel=list(
          ## default pixel dimensions
          default=128,
          check=function(x){
-           is.numeric(x) && (length(x) %in% c(1,2)) && is.finite(x) &&
+           is.numeric(x) && (length(x) %in% c(1,2)) && all(is.finite(x)) &&
            all(x == ceiling(x)) && all(x > 1) 
          },
          valid="an integer, or a pair of integers, greater than 1"
@@ -302,7 +306,8 @@ warn.once <- function(key, ...) {
          ## default total number of voxels
          default=2^22,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 2^12
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x > 2^12)
          },
          valid="a single integer, greater than 2^12"
        ),
@@ -352,13 +357,13 @@ warn.once <- function(key, ...) {
          ## under what conditions to print estimated SE in print.ppm
          default="poisson",
          check=function(x) { is.character(x) && length(x) == 1 &&
-                             x %in% c("always", "poisson", "never") },
+                             all(x %in% c("always", "poisson", "never")) },
          valid="one of the strings \'always\', \'poisson\' or \'never\'"
        ),
        progress = list(
          ## how to display progress reports
          default="tty",
-         check=function(x){ x %in% c("tty", "tk", "txtbar") },
+         check=function(x){ all(x %in% c("tty", "tk", "txtbar")) },
          valid="one of the strings 'tty', 'tk' or 'txtbar'"
          ),
        project.fast=list(
@@ -371,15 +376,17 @@ warn.once <- function(key, ...) {
          ## size of point grid for computing areas in psstA
          default=32,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x >= 8
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x >= 8)
          },
          valid="a single integer, greater than or equal to 8"
        ),
        psstA.nr=list(
          ## number of 'r' values to consider in psstA
          default=30,
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x >= 4
+           is.numeric(x) && length(x) == 1 &&
+             all(x == ceiling(x)) && all(x >= 4)
          },
          valid="a single integer, greater than or equal to 4"
        ),
@@ -400,22 +407,22 @@ warn.once <- function(key, ...) {
          ## default value of parameter 'nrep' in rmh
          default=5e5, 
          check=function(x) {
-           is.numeric(x) && length(x) == 1 && (x == ceiling(x)) && x > 0
+           is.numeric(x) && length(x) == 1 && all(x == ceiling(x)) && all(x > 0)
          },
          valid="a single integer, greater than 0"
        ),
        rmh.p=list(
          ## default value of parameter 'p' in rmh
          default=0.9,
          check=function(x) { is.numeric(x) && length(x) == 1 &&
-                             x >= 0 && x <= 1 },
+                             all(x >= 0) && all(x <= 1) },
          valid="a single numerical value, between 0 and 1"
        ),
        rmh.q=list(
          ## default value of parameter 'q' in rmh
          default=0.9,
          check=function(x) { is.numeric(x) && length(x) == 1 &&
-                             x > 0 && x < 1 },
+                             all(x > 0) && all(x < 1) },
          valid="a single numerical value, strictly between 0 and 1"
        ),
        scalable = list(
@@ -433,7 +440,7 @@ warn.once <- function(key, ...) {
        terse = list(
          ## Level of terseness in printed output (higher => more terse)
          default=0,
-         check=function(x) { length(x) == 1 && (x %in% 0:4) },
+         check=function(x) { length(x) == 1 && all(x %in% 0:4) },
          valid="an integer between 0 and 4"
        ),
        transparent=list(
@@ -446,7 +453,7 @@ warn.once <- function(key, ...) {
          default="(",
          check=function(x) {
            is.character(x) && (length(x) == 1) &&
-             (x %in% c("(", "[", "{", ""))
+             all(x %in% c("(", "[", "{", ""))
          },
          valid="one of the strings '(', '[', '{' or '' "
        ),

diff --git a/R/tess.R b/R/tess.R
@@ -3,7 +3,7 @@
 #
 # support for tessellations
 #
-#   $Revision: 1.86 $ $Date: 2018/07/06 03:46:03 $
+#   $Revision: 1.88 $ $Date: 2019/01/10 08:45:23 $
 #
 tess <- function(..., xgrid=NULL, ygrid=NULL, tiles=NULL, image=NULL,
                  window=NULL, marks=NULL, keepempty=FALSE,
@@ -824,6 +824,29 @@ intersect.tess <- function(X, Y, ..., keepmarks=FALSE) {
   return(out)
 }
 
+venn.tess <- function(..., window=NULL) {
+  argh <- list(...)
+  nargh <- length(argh)
+  if(nargh == 0) stop("No arguments given")
+  iswin <- sapply(argh, is.owin)
+  istes <- sapply(argh, is.tess)
+  if(!all(iswin | istes)) 
+    stop("All arguments must be windows or tessellations", call.=FALSE)
+  nama <- names(argh)
+  if(sum(nzchar(nama)) < nargh)
+    nama <- paste0("T", seq_len(nargh))
+  W <- window %orifnull% do.call(union.owin, unname(lapply(argh, as.owin)))
+  for(i in seq_len(nargh)) {
+    A <- argh[[i]]
+    if(is.owin(A)) {
+      Z <- list(A, Out=setminus.owin(W, A))
+      names(Z) <- paste0(c("", "not"), nama[i])
+      A <- tess(tiles=Z, window=W)
+    }
+    Y <- if(i == 1) A else intersect.tess(Y, A)
+  }
+  return(Y)
+}
 
 bdist.tiles <- local({
 

diff --git a/inst/doc/Nickname.txt b/inst/doc/Nickname.txt
@@ -1 +1 @@
-"Reliability You Can Count On"
+"Not Even Wrong"
diff --git a/inst/doc/packagesizes.txt b/inst/doc/packagesizes.txt
@@ -202,3 +202,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2018-11-03" "1.57-1" 1001 2584 0 110459 29954
 "2019-01-09" "1.58-0" 1002 2585 0 110702 30470
 "2019-01-10" "1.58-1" 1002 2585 0 110702 30470
+"2019-01-10" "1.58-2" 1003 2586 0 110732 30470
diff --git a/man/spatstat-package.Rd b/man/spatstat-package.Rd
@@ -632,6 +632,7 @@
       \code{\link{quadrats}} \tab create a tessellation of rectangles\cr
       \code{\link{hextess}} \tab create a tessellation of hexagons \cr
       \code{\link{quantess}} \tab quantile tessellation \cr
+      \code{\link{venn.tess}} \tab Venn diagram tessellation \cr 
       \code{\link{as.tess}} \tab convert other data to a tessellation \cr
       \code{\link{plot.tess}} \tab plot a tessellation \cr
       \code{\link{tiles}} \tab extract all the tiles of a tessellation \cr

diff --git a/man/tess.Rd b/man/tess.Rd
@@ -131,7 +131,7 @@
   \code{\link{as.function.tess}}.
 
   To construct particular tessellations, see
-  \code{\link{quadrats}}, \code{\link{hextess}},
+  \code{\link{quadrats}}, \code{\link{hextess}}, \code{\link{venn.tess}}
   \code{\link{dirichlet}}, \code{\link{delaunay}}
   and \code{\link{rpoislinetess}}.
 

diff --git a/man/venn.tess.Rd b/man/venn.tess.Rd
@@ -0,0 +1,55 @@
+\name{venn.tess}
+\alias{venn.tess}
+\title{
+  Tessellation Delimited by Several Sets
+}
+\description{
+  Given a list of windows, construct the tessellation
+  formed by all combinations of inclusion/exclusion of these
+  windows. 
+}
+\usage{
+venn.tess(\dots, window = NULL)
+}
+\arguments{
+  \item{\dots}{
+    Sets which delimit the tessellation.
+    Any number of windows (objects of class \code{"owin"})
+    or tessellations (objects of class \code{"tess"}).
+  }
+  \item{window}{
+    Optional. The bounding window of the resulting tessellation.
+    If not specified, the default is the union of all the
+    arguments \code{\dots}.
+  }
+}
+\details{
+  The arguments \code{\dots} may be any number of windows.
+  This function constructs a tessellation, like a Venn diagram,
+  whose boundaries are made up of the boundaries of these sets.
+  Each tile of the tessellation is defined by one of the 
+  possible combinations in which each set is either included or
+  excluded. 
+
+  If the arguments \code{\dots} are named, then the resulting tiles
+  will also have names, which identify the inclusion/exclusion
+  combinations defining each tile. See the Examples.
+}
+\value{
+  A tessellation (object of class \code{"tess"}).
+}
+\author{
+  \spatstatAuthors.
+}
+\seealso{
+  \code{\link{intersect.tess}}
+}
+\examples{
+   V <- venn.tess(A=square(1),
+                  B=square(c(-0.5, 0.5)),
+                  window=square(c(-1,1.5)))
+   V
+   plot(V, do.labels=TRUE)
+}
+\keyword{spatial}
+\keyword{math}