polyCub/0000755000176000001440000000000012250125023011707 5ustar ripleyuserspolyCub/inst/0000755000176000001440000000000012250105410012662 5ustar ripleyuserspolyCub/inst/examples/0000755000176000001440000000000012250105410014500 5ustar ripleyuserspolyCub/inst/examples/polyCub.iso.R0000644000176000001440000000135712236703051017050 0ustar ripleyusers## we use the example polygon and f (exponential decay) from example(plotpolyf) ## numerical approximation of 'intrfr' (intISOnum <- polyCub.iso(letterR, f, center=fcenter)) ## analytical 'intrfr' (recall: f_r(r)=dexp(r), we need int_0^R r*f(r) dr) intrfr <- function (R, rate=1) pgamma(R, 2, rate) / rate (intISOana <- polyCub.iso(letterR, intrfr=intrfr, center=fcenter)) stopifnot(all.equal(intISOana, intISOnum, check.attributes=FALSE)) ### polygon area: f(r) = 1, f(x,y) = 1, center does not really matter intrfr.const <- function (R) R^2/2 (area.ISO <- polyCub.iso(letterR, intrfr=intrfr.const, center=c(0,0))) stopifnot(all.equal(spatstat::area.owin(letterR), area.ISO, check.attributes=FALSE)) ## the hole region is subtracted correctly polyCub/inst/examples/polyCub.R0000644000176000001440000000324012236701727016260 0ustar ripleyusers### Short comparison of the different cubature methods ## 2D-function to integrate (here: isotropic zero-mean Gaussian density) f <- function (s, sigma = 5) exp(-rowSums(s^2)/2/sigma^2) / (2*pi*sigma^2) ## simple polygonal integration domain disc.owin <- spatstat::disc(radius=5, centre=c(3,2), npoly=8) ## plot image of the function and integration domain plotpolyf(disc.owin, f, xlim=c(-8,8), ylim=c(-8,8)) ### Quasi-exact cubature of the bivariate Gaussian density ### using gpclib::tristrip and mvtnorm::pmvnorm() if (requireNamespace("mvtnorm") && gpclibPermit()) { print(polyCub.exact.Gauss(disc.owin, mean=c(0,0), Sigma=5^2*diag(2), plot=TRUE), digits=16) } ### Two-dimensional midpoint rule testmidpoint <- function (eps, main=paste("2D midpoint rule with eps =",eps)) { plotpolyf(disc.owin, f, xlim=c(-8,8), ylim=c(-8,8), use.lattice=FALSE) ## add evaluation points to plot with(spatstat::as.mask(disc.owin, eps=eps), points(expand.grid(xcol, yrow), col=m, pch=20)) polyCub.midpoint(disc.owin, f, eps=eps) } testmidpoint(5) testmidpoint(3) testmidpoint(0.5) testmidpoint(0.2) ### Product Gauss cubature using an increasing number of nodes for (nGQ in c(1:5,10,20,60)) { cat("nGQ =", sprintf("%2i",nGQ), ": ", format(polyCub.SV(disc.owin, f, nGQ=nGQ), digits=16), "\n") } ## 'rotation' affects location of nodes opar <- par(mfrow=c(1,2)) polyCub.SV(disc.owin, f, nGQ=2, rotation=FALSE, plot=TRUE) polyCub.SV(disc.owin, f, nGQ=2, rotation=TRUE, plot=TRUE) par(opar) ### Line integration along the boundary for isotropic functions polyCub.iso(disc.owin, f, center=c(0,0)) # see ?polyCub.iso polyCub/inst/examples/plotpolyf.R0000644000176000001440000000050312236701571016667 0ustar ripleyusers### a polygonal domain data("letterR", package="spatstat") ### f: isotropic exponential decay fr <- function(r, rate=1) dexp(r, rate=rate) fcenter <- c(2,3) f <- function (s, rate=1) fr(sqrt(rowSums(t(t(s)-fcenter)^2)), rate=rate) ### plot plotpolyf(letterR, f, use.lattice=FALSE) plotpolyf(letterR, f, use.lattice=TRUE) polyCub/inst/tests/0000755000176000001440000000000012250105410014024 5ustar ripleyuserspolyCub/inst/tests/test-polyCub.R0000644000176000001440000000320112165556133016556 0ustar ripleyuserscontext("correctness of cubature methods") ### set up test case ## bivariate, isotropic Gaussian density f <- function (s, mean, sd) dnorm(s[,1], mean=mean[1], sd=sd) * dnorm(s[,2], mean=mean[2], sd=sd) ## circular domain represented by a polygon r <- 5 center <- c(3,2) npoly <- 128 disc.owin <- spatstat::disc(radius=r, centre=center, npoly=npoly) ## parameters for f m <- c(1,1) sd <- 3 ## exact value of the integral over the _polygonal_ circle gpclibPermit() intExact <- polyCub.exact.Gauss(disc.owin, mean=m, Sigma=sd^2*diag(2)) ### perform the tests (check against each other) test_that("polyCub.exact.Gauss and circleCub.Gauss give similar results", { ## exact value of the integral over the _real_ circle intExact_circle <- circleCub.Gauss(center=center, r=r, mean=m, sd=sd) ## how well this fits with the exact integral over a polyonal approximation ## of the circle depends of course on 'npoly' expect_that(intExact, equals(intExact_circle, tolerance=0.001, check.attributes=FALSE)) }) test_that("midpoint-cubature is correct", { int <- polyCub.midpoint(disc.owin, f, mean=m, sd=sd, dimyx=500) expect_that(int, equals(intExact, tolerance=0.001, check.attributes=FALSE)) }) test_that("SV-cubature is correct", { int <- polyCub.SV(disc.owin, f, mean=m, sd=sd, nGQ=3) expect_that(int, equals(intExact, tolerance=0.0001, check.attributes=FALSE)) }) test_that("isotropic cubature is correct", { ## using a numerical approximation of intrfr int0 <- polyCub.iso(disc.owin, f, mean=m, sd=sd, center=m) expect_that(int0, equals(intExact, check.attributes=FALSE)) }) polyCub/inst/NEWS.Rd0000644000176000001440000001035112250104145013731 0ustar ripleyusers\newcommand{\CRANpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}} %% some pre-defined commands: \R, \code, \acronym, \url, \file, \pkg \name{NEWS} \title{News for Package 'polyCub'} \section{Changes in polyCub version 0.4-1 (2013-12-05)}{ \itemize{ \item This version solely fixes a missing \file{NAMESPACE} import to make package \pkg{polyCub} again compatible with older versions of \CRANpkg{spatstat} (< 1.33-0). } } \section{Changes in polyCub version 0.4-0 (2013-11-19)}{ \subsection{INFRASTRUCTURE}{ \itemize{ \item \CRANpkg{rgeos} (and therefore the GEOS library) is no longer strictly required (moved from Imports to Suggests). \item Added \code{coerce}-methods from \code{"Polygons"} (or \code{"SpatialPolygons"} or \code{"Polygon"}) to \code{"owin"} (\code{as(..., "owin")}). \item \acronym{S4}-style \code{coerce}-methods between \code{"gpc.poly"} and \code{"Polygons"}/\code{"owin"} have been removed from the package (since we no longer import the formal class \code{"gpc.poly"} from \pkg{gpclib} or \pkg{rgeos}). However, there are two new functions \code{gpc2owin} and \code{owin2gpc} similar to those dropped from \CRANpkg{spatstat} since version 1.34-0. \item Moved \code{discpoly()} back to \CRANpkg{surveillance} since it is only used there. \item The latter two changes cause \CRANpkg{surveillance} version 1.6-0 to be incompatible with this new version of \pkg{polyCub}. Appropriate modifications have been made in the new version 1.7-0 of \pkg{surveillance}. } } \subsection{SPEED-UP \code{polyCub.SV()}}{ \itemize{ \item thorough optimization of \code{polyCub.SV()}-related code resulted in about 27\% speed-up: \itemize{ \item use \code{mapply()} instead of a \code{for}-loop \item avoid \code{cbind()} \item use \code{tcrossprod()} \item less object copying } } } \subsection{MINOR CHANGES}{ \itemize{ \item \code{xylist()} is now exported. It simply extracts polygon coordinates from various spatial classes (with same unifying intention as \code{xy.coords()}). \item A \code{polyregion} of class \code{"SpatialPolygons"} of length more than 1 now works in \code{polyCub}-methods. \item Use aspect ratio of 1 in \code{plotpolyf()}. } } } \section{Changes in polyCub version 0.3-1 (2013-08-22)}{ \itemize{ \item This version solely fixes a few typos and a technical note from \command{R CMD check} in the current R development version (also import packages into the \file{NAMESPACE} which are listed in the \dQuote{Depends:} field). } } \section{Changes in polyCub version 0.3-0 (2013-07-06)}{ \itemize{ \item New cubature method \code{polyCub.iso()} specific to isotropic functions (thanks to Emil Hedevang for the basic idea). \item New function \code{plotpolyf()} to plot a polygonal domain on top of an image of a bivariate function. \item The package now depends on \R >= 2.15.0 (for \code{.rowSums()}). \item The package no longer registers \code{"owin"} as an \acronym{S4}-class since we depend on the \pkg{sp} package which does the job. This avoids a spurious warning (in \code{.simpleDuplicateClass()}) upon package installation. \item In \code{discpoly()}, the argument \code{r} has been renamed to \code{radius}. This is backward compatible by partial argument matching in old code. } } \section{Changes in polyCub version 0.2-0 (2013-05-09)}{ \itemize{ \item This is the initial version of the \pkg{polyCub} package mainly built on functions previously maintained within the \CRANpkg{surveillance} package. These methods for cubature of polygonal domains have been outsourced into this separate \pkg{polyCub} package since they are of general use for other packages as well. \item The \pkg{polyCub} package has more documentation and tests, avoids the use of \CRANpkg{gpclib} as far as possible (using \CRANpkg{rgeos} instead), and solves a compatibility issue with package \CRANpkg{maptools} (use \code{setClass("owin")} instead of \code{setOldClass("owin")}). } } polyCub/tests/0000755000176000001440000000000012250105410013047 5ustar ripleyuserspolyCub/tests/test-all.R0000644000176000001440000000010012142665517014731 0ustar ripleyuserslibrary("testthat") library("polyCub") test_package("polyCub") polyCub/NAMESPACE0000644000176000001440000000217212250102275013134 0ustar ripleyusersS3method(xylist,Polygon) S3method(xylist,Polygons) S3method(xylist,SpatialPolygons) S3method(xylist,default) S3method(xylist,gpc.poly) S3method(xylist,owin) export(.polyCub.iso) export(circleCub.Gauss) export(gpc2owin) export(gpclibPermit) export(gpclibPermitStatus) export(owin2gpc) export(plotpolyf) export(polyCub) export(polyCub.SV) export(polyCub.exact.Gauss) export(polyCub.iso) export(polyCub.midpoint) export(xylist) exportMethods(coerce) import(methods) import(sp) importFrom(grDevices,extendrange) importFrom(grDevices,gray) importFrom(grDevices,heat.colors) importFrom(grDevices,xy.coords) importFrom(graphics,image) importFrom(graphics,points) importFrom(graphics,polygon) importFrom(spatstat,area.xypolygon) importFrom(spatstat,as.im.function) importFrom(spatstat,as.polygonal) importFrom(spatstat,is.hole.xypolygon) importFrom(spatstat,is.polygonal) importFrom(spatstat,owin) importFrom(spatstat,plot.im) importFrom(spatstat,plot.owin) importFrom(spatstat,reverse.xypolygon) importFrom(statmod,gauss.quad) importFrom(stats,cov2cor) importFrom(stats,dist) importFrom(stats,integrate) importFrom(stats,pchisq) importFrom(stats,pnorm) polyCub/R/0000755000176000001440000000000012250105410012106 5ustar ripleyuserspolyCub/R/polyCub.SV.R0000644000176000001440000002512712236771524014227 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[polyCub.SV.R] by SM Don 07/11/2013 21:08 (CET)> ################################################################################ #' Product Gauss Cubature over Polygonal Domains #' #' Product Gauss cubature over polygons as proposed by #' Sommariva and Vianello (2007). #' #' @param polyregion a polygonal integration domain. #' The following classes are supported: \code{"\link[spatstat]{owin}"}, #' \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"}, #' \code{"\linkS4class{SpatialPolygons}"}, \code{"\linkS4class{Polygons}"}, #' and \code{"\linkS4class{Polygon}"} #' (for these we have an internal \code{\link{xylist}} method). #' @param f two-dimensional function. #' As its first argument it must take a coordinate matrix, i.e. a #' numeric matrix with two columns. #' @param ... further arguments for \code{f}. #' @param nGQ degree of the one-dimensional Gauss-Legendre quadrature rule #' (default: 20). See \code{\link[statmod]{gauss.quad}} in package #' \pkg{statmod}, on which this function depends. #' @param plot logical indicating if an illustrative plot of the numerical #' integration should be produced. #' @inheritParams polygauss #' @return The approximated value of the integral of \code{f} over #' \code{polyregion}. #' @author Sebastian Meyer\cr #' The product Gauss cubature is based on the #' original \acronym{MATLAB} implementation \code{polygauss} by Sommariva and #' Vianello (2007), which is available under the GNU GPL (>=2) license from #' \url{http://www.math.unipd.it/~alvise/software.html}. #' @references #' A. Sommariva and M. Vianello (2007). #' Product Gauss cubature over polygons based on Green's integration formula. #' Bit Numerical Mathematics, 47 (2), 441-453. #' @keywords math spatial #' @family polyCub-methods #' @importFrom statmod gauss.quad #' @importFrom graphics points #' @examples # see example(polyCub) #' @export polyCub.SV <- function (polyregion, f, ..., nGQ = 20, alpha = NULL, rotation = FALSE, plot = FALSE) { polys <- xylist(polyregion) # transform to something like "owin$bdry" # which means anticlockwise vertex order with # first vertex not repeated f <- match.fun(f) stopifnot(isScalar(nGQ), is.null(alpha) || (isScalar(alpha) && !is.na(alpha))) ## COMPUTE NODES AND WEIGHTS OF 1D GAUSS QUADRATURE RULE. ## DEGREE "N" (as requested) (ORDER GAUSS PRIMITIVE) nw_N <- gauss.quad(n = nGQ, kind = "legendre") ## DEGREE "M" = N+1 (ORDER GAUSS INTEGRATION) nw_M <- gauss.quad(n = nGQ + 1, kind = "legendre") ## in one list nw_MN <- unname(c(nw_M, nw_N)) ## Cubature of every single polygon of the "polys" list int1 <- function (poly) { nw <- polygauss(poly, nw_MN, alpha, rotation) fvals <- f(nw$nodes, ...) cubature_val <- sum(nw$weights * fvals) ## if (!isTRUE(all.equal(0, cubature_val))) { ## if ((1 - 2 * as.numeric(poly$hole)) * sign(cubature_val) == -1) ## warning("wrong sign if positive integral") ## } cubature_val } respolys <- sapply(polys, int1, simplify = TRUE, USE.NAMES = FALSE) int <- sum(respolys) ### ILLUSTRATION ### if (plot) { plotpolyf(polys, f, ..., use.lattice=FALSE) for (i in seq_along(polys)) { nw <- polygauss(polys[[i]], nw_MN, alpha, rotation) points(nw$nodes, cex=0.6, pch = i) #, col=1+(nw$weights<=0) } } ################### int } ##' Calculate 2D Nodes and Weights of the Product Gauss Cubature ##' ##' @param xy list with elements \code{"x"} and \code{"y"} containing the ##' polygon vertices in \emph{anticlockwise} order (otherwise the result of the ##' cubature will have a negative sign) with first vertex not repeated at the ##' end (like \code{owin.object$bdry}). ##' @param nw_MN unnamed list of nodes and weights of one-dimensional Gauss ##' quadrature rules of degrees \eqn{N} and \eqn{M=N+1} (as returned by ##' \code{\link[statmod]{gauss.quad}}): \code{list(s_M, w_M, s_N, w_N)}. ##' @param alpha base-line of the (rotated) polygon at \eqn{x = \alpha} (see ##' Sommariva and Vianello (2007) for an explication). If \code{NULL} (default), ##' the midpoint of the x-range of the polygon is chosen if no \code{rotation} ##' is performed, and otherwise the \eqn{x}-coordinate of the rotated point ##' \code{"P"}. If \code{f} has its maximum value at the origin \eqn{(0,0)}, ##' e.g., the bivariate Gaussian density with zero mean, \code{alpha = 0} is a ##' reasonable choice. ##' @param rotation logical (default: \code{FALSE}) or a list of points ##' \code{"P"} and \code{"Q"} describing the preferred direction. If ##' \code{TRUE}, the polygon is rotated according to the vertices \code{"P"} and ##' \code{"Q"}, which are farthest apart (see Sommariva and Vianello, 2007). For ##' convex polygons, this rotation guarantees that all nodes fall inside the ##' polygon. ##' @references ##' A. Sommariva and M. Vianello (2007): ##' Product Gauss cubature over polygons based on Green's integration formula. ##' Bit Numerical Mathematics, 47 (2), 441-453. ##' @keywords internal polygauss <- function (xy, nw_MN, alpha = NULL, rotation = FALSE) { ## convert to coordinate matrix xy <- cbind(xy[["x"]], xy[["y"]], deparse.level=0) ## POLYGON ROTATION xyrot <- if (identical(FALSE, rotation)) { if (is.null(alpha)) { # choose midpoint of x-range xrange <- range(xy[,1L]) alpha <- (xrange[1L] + xrange[2L]) / 2 } angle <- 0 xy } else { if (identical(TRUE, rotation)) { # automatic choice of rotation angle ## such that for a convex polygon all nodes fall inside the polygon QP <- vertexpairmaxdist(xy) Q <- QP[1L,,drop=TRUE] P <- QP[2L,,drop=TRUE] } else if (is.list(rotation)) { # predefined rotation P <- rotation$P Q <- rotation$Q stopifnot(is.vector(P, mode="numeric") && length(P) == 2L, is.vector(Q, mode="numeric") && length(Q) == 2L) stopifnot(any(P != Q)) rotation <- TRUE } else { stop("'rotation' must be logical or a list of points \"P\" and \"Q\"") } rotmat <- rotmatPQ(P,Q) angle <- attr(rotmat, "angle") if (is.null(alpha)) { Prot <- rotmat %*% P alpha <- Prot[1] } xy %*% t(rotmat) # = t(rotmat %*% t(xy)) } ## COMPUTE 2D NODES AND WEIGHTS. sides <- cbind(xyrot, xyrot[c(2:nrow(xyrot),1L),,drop=FALSE], deparse.level=0) # (x1,y1,x2,y2) nwlist <- mapply(.polygauss.side, sides[,1L], sides[,2L], sides[,3L], sides[,4L], MoreArgs = c(nw_MN, alpha), SIMPLIFY = FALSE, USE.NAMES = FALSE) ## nodes <- c(subListExtract(nwlist, "x", use.names=FALSE), ## subListExtract(nwlist, "y", use.names=FALSE), ## recursive=TRUE) nodes <- c(lapply(nwlist, "[[", 1L), lapply(nwlist, "[[", 2L), recursive=TRUE) dim(nodes) <- c(length(nodes)/2, 2L) #nw <- .Call("polygauss", # xyrot[,1L],xyrot[,2L],alpha, # nw_N$nodes,nw_N$weights,nw_M$nodes,nw_M$weights, # PACKAGE="surveillance") ## back-transform rotated nodes by t(t(rotmat) %*% t(nodes)) ## (inverse of rotation matrix is its transpose) list(nodes = if (rotation) nodes %*% rotmat else nodes, #weights = unlist(subListExtract(nwlist, "w", use.names=FALSE), recursive=FALSE, use.names=FALSE), weights = unlist(lapply(nwlist, "[[", 3L), recursive=FALSE, use.names=FALSE), angle = angle, alpha = alpha) } ## The working horse .polygauss.side below is an R translation ## of the original MATLAB implementation by Sommariva and Vianello (2007). ## TODO: efficient implementation of this function in C ## might increase the speed of the cubature (although this is already ## highly efficient R code) .polygauss.side <- function (x1, y1, x2, y2, s_loc, w_loc, s_N, w_N, alpha) { if ((x1 == alpha && x2 == alpha) || (y2 == y1)) ## side lies on base-line or is orthogonal to it -> skip return(NULL) if (x2 == x1) { # side is parallel to base-line => degree N s_loc <- s_N w_loc <- w_N } half_pt_x <- (x1+x2)/2 half_length_x <- (x2-x1)/2 half_pt_y <- (y1+y2)/2 half_length_y <- (y2-y1)/2 ## GAUSSIAN POINTS ON THE SIDE. x_gauss_side <- half_pt_x + half_length_x * s_loc y_gauss_side <- half_pt_y + half_length_y * s_loc scaling_fact_minus <- (x_gauss_side - alpha) / 2 ## construct nodes and weights: x and y coordinates ARE STORED IN MATRICES. ## A COUPLE WITH THE SAME INDEX IS A POINT, i.e. P_i=(x(k),y(k)). ## Return in an unnamed list of nodes_x, nodes_y, weights ## (there is no need for c(nodes_x) and c(weights)) list(alpha + tcrossprod(scaling_fact_minus, s_N + 1), # degree_loc x N rep.int(y_gauss_side, length(s_N)), # length: degree_loc*N tcrossprod(half_length_y*scaling_fact_minus*w_loc, w_N)) # degree_loc x N } ##' @importFrom stats dist vertexpairmaxdist <- function (xy) { ## compute euclidean distance matrix distances <- dist(xy) size <- attr(distances, "Size") ## select two points with maximum distance maxdistidx <- which.max(distances) lowertri <- seq_along(distances) == maxdistidx mat <- matrix(FALSE, size, size) mat[lower.tri(mat)] <- lowertri QPidx <- which(mat, arr.ind=TRUE, useNames=FALSE)[1L,] xy[QPidx,] } rotmatPQ <- function (P, Q) { direction_axis <- (Q-P) / sqrt(sum((Q-P)^2)) ## determine rotation angle rot_angle_x <- acos(direction_axis[1L]) rot_angle_y <- acos(direction_axis[2L]) rot_angle <- if (rot_angle_y <= pi/2) { if (rot_angle_x <= pi/2) -rot_angle_y else rot_angle_y } else { if (rot_angle_x <= pi/2) pi-rot_angle_y else rot_angle_y } ## cat(sprintf(' [ANGLE CLOCKWISE (IN DEGREES)]: %5.5f\n', rot_angle*180/pi)) ## rotation matrix rot_matrix <- diag(cos(rot_angle), nrow=2L) rot_matrix[2:3] <- c(-1,1) * sin(rot_angle) # clockwise rotation structure(rot_matrix, angle=rot_angle) } polyCub/R/polyCub.iso.R0000644000176000001440000001730512236770423014465 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2013 Sebastian Meyer ### Time-stamp: <[polyCub.iso.R] by SM Don 07/11/2013 20:59 (CET)> ################################################################################ #' Cubature of Isotropic Functions over Polygonal Domains #' #' Conducts numerical integration of a two-dimensional isotropic function #' \eqn{f(x,y) = f_r(||(x,y)-\boldsymbol{\mu}||)}{f(x,y) = f_r(||(x,y)-\mu||)} #' with \eqn{\mu} being the center of isotropy, #' over a polygonal domain. #' It internally solves a line integral along the polygon boundary using #' \code{\link{integrate}} where the integrand requires the antiderivative of #' \eqn{r f_r(r)}), which ideally is analytically available and supplied to the #' function as argument \code{intrfr}. #' The two-dimensional integration problem thereby reduces to an efficient #' adaptive quadrature in one dimension. #' #' @inheritParams polyCub.SV #' @param intrfr analytical antiderivative of \eqn{r f_r(r)} from 0 to \code{R} #' (first argument, not necessarily named \code{"R"}, must be vectorized). #' If given, \code{f} is not required (except for plotting)! #' If missing, \code{intrfr} is approximated numerically, again using #' \code{\link{integrate}}. #' @param ... further arguments for \code{f} or \code{intrfr}. #' @param center numeric vector of length 2, the center of isotropy. #' @param control list of arguments passed to \code{\link{integrate}}, the #' quadrature rule used for the line integral along the polygon boundary. #' @param check.intrfr logical (or numeric vector) indicating if #' (for which \code{r}'s) the supplied \code{intrfr} function should be #' checked against a numeric approximation. If \code{TRUE}, the set of test #' \code{r}'s defaults to a \code{\link{seq}} of length 20 from 1 to #' the maximum absolute x or y coordinate of any edge of the \code{polyregion}. #' @return The approximate integral of the isotropic function #' \code{f} over \code{polyregion}.\cr #' If the \code{intrfr} function is provided (which is assumed to be exact), an #' upperbound for the absolute integration error is appended to the result as #' attribute \code{"abs.error"}. It equals the sum of the absolute errors #' reported by all \code{\link{integrate}} calls #' (there is one for each edge of \code{polyregion}). #' @author Sebastian Meyer #' #' The basic idea for this cubature rule is due to Emil Hedevang (2013), #' Dept. of Mathematics, Aarhus University, Denmark #' @references #' E. Hedevang (2013). Personal communication at the Summer School on Topics in #' Space-Time Modeling and Inference (May 2013, Aalborg, Denmark). #' @keywords math spatial #' @family polyCub-methods #' @example inst/examples/polyCub.iso.R #' @importFrom stats integrate #' @export polyCub.iso <- function (polyregion, f, intrfr, ..., center, control = list(), check.intrfr = FALSE, plot = FALSE) { polys <- xylist(polyregion) # transform to something like "owin$bdry" # which means anticlockwise vertex order with # first vertex not repeated getError <- TRUE doCheck <- !identical(FALSE, check.intrfr) if (!missing(f)) { f <- match.fun(f) rfr <- function (r, ...) r * f(cbind(center[1]+r,center[2],deparse.level=0), ...) quadrfr1 <- function (r, ...) integrate(rfr, 0, r, ...)$value quadrfr <- function (r, ...) sapply(r, quadrfr1, ..., USE.NAMES=FALSE) if (missing(intrfr)) { intrfr <- quadrfr getError <- FALSE # can't estimate error of double approximation } else if (doCheck) { cat("Checking 'intrfr' against a numeric approximation ... ") .rs <- if (isTRUE(check.intrfr)) { seq(1, max(abs(unlist(lapply(polys, "[", c("x","y"))))), length.out=20) } else { stopifnot(is.vector(check.intrfr, mode="numeric")) check.intrfr } ana <- intrfr(.rs, ...) num <- quadrfr(.rs, ...) cat(comp <- all.equal(num, ana), "\n") if (!isTRUE(comp)) { cat("->", comp, "\n") warning("'intrfr' might be incorrect: ", comp) } } } else if (doCheck) stop("numerical verification of 'intrfr' requires 'f'") intrfr <- match.fun(intrfr) if (plot) plotpolyf(polys, f, ...) ## do the cubature over all polygons of the 'polys' list .polyCub.iso(polys, intrfr, ..., center=center, control=control, .witherror=getError) } ##' \code{.polyCub.iso} is a \dQuote{bare-bone} version of \code{polyCub.iso}. ##' @rdname polyCub.iso ##' @param polys something like \code{owin$bdry}, but see \code{\link{xylist}}. ##' @param .witherror logical indicating if an upperbound for the absolute ##' integration error should be attached as an attribute to the result? ##' @export .polyCub.iso <- function (polys, intrfr, ..., center, control = list(), .witherror = FALSE) { ints <- lapply(polys, polyCub1.iso, intrfr, ..., center=center, control=control, .witherror=.witherror) if (.witherror) { structure(sum(sapply(ints, "[", 1, simplify=TRUE, USE.NAMES=FALSE)), abs.error=sum(sapply(ints, "[", 2, simplify=TRUE, USE.NAMES=FALSE))) } else sum(unlist(ints, recursive=FALSE, use.names=FALSE)) } ## cubature method for a single polygon polyCub1.iso <- function (poly, intrfr, ..., center, control, .witherror = TRUE) { xy <- cbind(poly[["x"]], poly[["y"]], deparse.level=0) nedges <- nrow(xy) intedges <- erredges <- numeric(nedges) for (i in seq_len(nedges)) { v0 <- xy[i,] - center v1 <- xy[if (i==nedges) 1 else i+1,] - center int <- lineInt(v0, v1, intrfr, ..., control=control) intedges[i] <- int$value erredges[i] <- int$abs.error } int <- sum(intedges) ## if (!is.null(poly$hole) && !isTRUE(all.equal(0, int))) { ## if ((1 - 2 * as.numeric(poly$hole)) * sign(int) == -1) ## warning("wrong sign if positive integral") ## } c(int, if (.witherror) sum(erredges)) } ## line integral for one edge ##' @importFrom stats integrate lineInt <- function (v0, v1, intrfr, ..., control) { d <- v1 - v0 num <- v1[2]*v0[1] - v1[1]*v0[2] # = d[2]*p[,1] - d[1]*p[,2] # for any point p on the edge integrand <- function (t) { ## get the points on the edge corresponding to t p <- cbind(v0[1] + t*d[1], v0[2] + t*d[2], deparse.level=0) norm2 <- .rowSums(p^2, length(t), 2) ints <- intrfr(sqrt(norm2), ...) ##ints[is.infinite(ints)] <- 1e300 num * ints / norm2 } if (length(control)) { # use slower do.call()-construct do.call("integrate", c(list(integrand, 0, 1), control=control)) } else integrate(integrand, 0, 1) } ## equally fast method _only_ for convex polygonal domains including the origin ## (formula obtained via polar coordinate representation) lineInt2 <- function (v0, v1, intrfr, ..., control) { d <- v1 - v0 ld <- vecnorm(d) l0 <- vecnorm(v0) l1 <- vecnorm(v1) dp <- dotprod(v0,v1) theta <- acos((l0 - dp/l0) / ld) num <- sin(theta) * l0 phispan <- acos(dp / l0 / l1) integrand <- function (phi, ...) { r <- num / sin(theta+phi) intrfr(r, ...) } do.call("integrate", c(list(integrand, 0, phispan, ...), control=control)) } polyCub/R/polyCub.R0000644000176000001440000000444712165773342013703 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[polyCub.R] by SM Sam 06/07/2013 12:52 (CEST)> ################################################################################ #' Wrapper Function for the Various Cubature Methods #' #' Instead of calling one of the specific cubature methods of this package, the #' wrapper function \code{polyCub} may be used together with the \code{method} #' argument. #' #' @param polyregion a polygonal integration domain. #' The supported classes depend on the specific method, however, the #' \code{"\link[spatstat]{owin}"} class from package \pkg{spatstat} works for #' all methods, as well should a \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} #' polygon (but see the comments in \code{help("\link{coerce-methods}")}). #' @param f two-dimensional function to be integrated. #' As its first argument the function must take a coordinate matrix, i.e. a #' numeric matrix with two columns. For the \code{"exact.Gauss"} \code{method}, #' \code{f} is ignored since it is specific to the bivariate normal density. #' @param method choose one of the implemented cubature methods (partial #' argument matching is applied), see \code{help("\link{polyCub-package}")} #' for an overview. Defaults to using the product Gauss cubature #' implemented in \code{\link{polyCub.SV}}. #' @param ... arguments of \code{f} or of the specific \code{method}. #' @param plot logical indicating if an illustrative plot of the numerical #' integration should be produced. #' @return The approximated integral of \code{f} over \code{polyregion}. #' @example inst/examples/polyCub.R #' @keywords math spatial #' @family polyCub-methods #' @export polyCub <- function (polyregion, f, method = c("SV", "midpoint", "iso", "exact.Gauss"), ..., plot = FALSE) { method <- match.arg(method) cl <- match.call() cl$method <- NULL cl[[1]] <- as.name(paste("polyCub", method, sep=".")) if (method == "exact.Gauss") cl$f <- NULL int <- eval(cl, parent.frame()) int #structure(int, method = method) } polyCub/R/polyCub.midpoint.R0000644000176000001440000000666212236771317015525 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[polyCub.midpoint.R] by SM Don 07/11/2013 21:06 (CET)> ################################################################################ #' Two-Dimensional Midpoint Rule #' #' The surface is converted to a binary pixel image #' using the \code{\link[spatstat]{as.im.function}} method from package #' \pkg{spatstat}. The integral under the surface is then approximated as the #' sum over (pixel area * f(pixel midpoint)). #' #' @param polyregion a polygonal integration domain. #' It can be any object coercible to the \pkg{spatstat} class #' \code{"\link[spatstat]{owin}"} (via \code{\link[spatstat]{as.owin}}). #' @param f two-dimensional function to be integrated. #' As its first argument the function must take a coordinate matrix, i.e. a #' numeric matrix with two columns. #' @param ... further arguments for \code{f}. #' @param eps width and height of the pixels (squares), #' see \code{\link[spatstat]{as.mask}}. #' @param dimyx number of subdivisions in each dimension, #' see \code{\link[spatstat]{as.mask}}. #' @param plot logical indicating if an illustrative plot of the numerical #' integration should be produced. #' @return The approximated value of the integral of \code{f} over #' \code{polyregion}. #' @references #' A. Baddeley and R. Turner (2005). #' Spatstat: an R package for analyzing spatial point patterns. #' Journal of Statistical Software 12 (6), 1-42. #' @keywords math spatial #' @family polyCub-methods #' @import sp #' @importFrom spatstat as.im.function plot.im #' @importFrom grDevices gray #' @examples # see example(polyCub) #' @export polyCub.midpoint <- function (polyregion, f, ..., eps = NULL, dimyx = NULL, plot = FALSE) { ## as.im needs seperate x and y arguments fxy <- function (x, y, ...) f(cbind(x,y), ...) ## calculate pixel values of fxy IM <- tryCatch( as.im.function(X=fxy, W=polyregion, ..., eps=eps, dimyx=dimyx), error = function (e) { ## if eps was to small such that the dimensions of the image would ## be too big then the operation matrix(TRUE, nr, nc) throws an ## error. (try e.g. devnull <- matrix(TRUE, 1e6,1e6)) ## unfortunately, it is not clear what we should do in this ## case... => stop stop("inapplicable choice of bandwidth (eps=", format(eps), ") in midpoint rule:\n", e) }) ### ILLUSTRATION ### if (plot) { plot.im(IM, axes=TRUE, col=gray(31:4/35), main="") ## add evaluation points (unsure about spatstat implementation of class "im") ## both of the following commands worked with different versions of spatstat #with(IM, points(expand.grid(xcol, yrow), col=!is.na(v), cex=0.5)) #with(IM, points(expand.grid(y=yrow, x=xcol)[2:1], col=!is.na(v), cex=0.5)) plot(polyregion, add=TRUE, poly.args=list(lwd=2), lwd=2) ##<- two 'lwd'-specifications such that it works with owin and gpc.poly } #################### ## return the approximated integral pixelarea <- IM$xstep * IM$ystep int <- pixelarea * sum(IM$v, na.rm = TRUE) int } polyCub/R/xylist.R0000644000176000001440000001273612236771660013622 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2012-2013 Sebastian Meyer ### Time-stamp: <[xylist.R] by SM Don 07/11/2013 21:10 (CET)> ### ### Convert various polygon classes to a simple "xylist" ################################################################################ ##' Convert Various Polygon Classes to a Simple List of Vertices ##' ##' Different packages concerned with spatial data use different polygon ##' specifications, which sometimes becomes very confusing (see Details below). ##' To be compatible with the various polygon classes, package \pkg{polyCub} ##' uses an S3 class \code{"xylist"}, which represents ##' polygons by their core feature only, a list of lists of vertex coordinates ##' (see the "Value" section below). ##' The generic function \code{xylist} can deal with the ##' following polygon classes: ##' \itemize{ ##' \item{\code{"\link[spatstat:owin.object]{owin}"} from package \pkg{spatstat}} ##' \item{\code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} from package ##' \pkg{rgeos} (or \pkg{gpclib})} ##' \item{\code{"\link[sp:Polygons-class]{Polygons}"} from package \pkg{sp} ##' (as well as \code{"\link[sp:Polygon-class]{Polygon}"} and ##' \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"})} ##' } ##' The (somehow useless) default \code{xylist}-method ##' does not perform any transformation but only ensures that the polygons are ##' not closed (first vertex not repeated). ##' ##' Different packages concerned with spatial data use different polygon ##' specifications with respect to: ##' \itemize{ ##' \item{do we repeat the first vertex?} ##' \item{which direction represents holes?} ##' } ##' Package overview: ##' \describe{ ##' \item{\pkg{sp}:}{\emph{Repeat} first vertex at the end (closed), ##' anticlockwise = hole, clockwise = normal boundary} ##' \item{\pkg{spatstat}:}{do \emph{not repeat} first vertex, ##' anticlockwise = normal boundary, clockwise = hole. This convention is also ##' used in \code{xylist}.} ##' \item{\pkg{gpclib}:}{Unfortunately, there seems to be no convention ##' for the specification of polygons of class \code{"gpc.poly"}.} ##' } ##' ##' @param object an object of one of the supported spatial classes. ##' @param ... (unused) argument of the generic. ##' @return Applying \code{xylist} to a polygon object, one gets a simple list, ##' where each component (polygon) is a list of \code{"x"} and \code{"y"} ##' coordinates. These represent vertex coordinates following \pkg{spatstat}'s ##' \code{"owin"} convention (anticlockwise order without repeating any vertex). ##' The opposite vertex order can be retained for the \pkg{sp}-classes ##' by the non-default use with \code{reverse=FALSE}.\cr ##' @author Sebastian Meyer\cr ##' The implementation of the \code{"gpc.poly"}-method of \code{xylist} ##' depends on functionality of the \pkg{spatstat} package and borrows ##' large parts from the function \code{gpc2owin} (as implemented in package ##' \pkg{spatstat} before version 1.34-0, when support for \code{"gpc.poly"} was ##' dropped) authored by Adrian Baddeley and Rolf Turner. ##' @name xylist ##' @keywords spatial methods ##' @export xylist <- function (object, ...) UseMethod("xylist") ##' @method xylist owin ##' @S3method xylist owin ##' @rdname xylist ##' @importFrom spatstat is.polygonal xylist.owin <- function (object, ...) { if (is.polygonal(object)) object$bdry else { stop("object is not polygonal") } } ##' @method xylist gpc.poly ##' @S3method xylist gpc.poly ##' @rdname xylist ##' @importFrom spatstat area.xypolygon reverse.xypolygon xylist.gpc.poly <- function (object, ...) { lapply(object@pts, function (poly) { if (poly$hole != (area.xypolygon(poly) < 0)) poly <- reverse.xypolygon(poly) poly[c("x","y")] }) } ##' @method xylist SpatialPolygons ##' @S3method xylist SpatialPolygons ##' @rdname xylist ##' @inheritParams xylist.Polygons xylist.SpatialPolygons <- function (object, reverse = TRUE, ...) { unlist(lapply(object@polygons, xylist.Polygons, reverse=reverse, ...), recursive=FALSE, use.names=FALSE) } ##' @method xylist Polygons ##' @S3method xylist Polygons ##' @rdname xylist ##' @param reverse logical (\code{TRUE}) indicating if the vertex order of the ##' \pkg{sp} classes should be reversed to get the \code{xylist}/\code{owin} ##' convention. ##' @import sp xylist.Polygons <- function (object, reverse = TRUE, ...) { lapply(object@Polygons, function (sr) { coords <- coordinates(sr) n <- nrow(coords) - 1L # number of vertices idxs <- if (reverse) seq.int(n,1) else seq_len(n) list(x = coords[idxs,1L], y = coords[idxs,2L]) #area = sr@area, hole = sr@hole }) } ##' @method xylist Polygon ##' @S3method xylist Polygon ##' @rdname xylist ##' @import methods xylist.Polygon <- function (object, reverse = TRUE, ...) xylist.Polygons(as(object,"Polygons"), reverse=reverse, ...) ##' @method xylist default ##' @S3method xylist default ##' @rdname xylist ##' @importFrom grDevices xy.coords xylist.default <- function (object, ...) { lapply(object, function (xy) { poly <- xy.coords(xy)[c("x","y")] if (isClosed(poly)) { sel <- seq_len(length(poly$x) - 1L) poly$x <- poly$x[sel] poly$y <- poly$y[sel] } poly }) } polyCub/R/polyCub.exact.Gauss.R0000644000176000001440000001653412236771275016071 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[polyCub.exact.Gauss.R] by SM Don 07/11/2013 21:06 (CET)> ################################################################################ #' Quasi-Exact Cubature of the Bivariate Normal Density #' #' Integration is based on triangulation of the polygonal domain and formulae #' from Chapter 26 of the #' Abramowitz & Stegun handbook (Section 26.9, Example 9, pp. 956f.). #' This method is quite cumbersome because the A&S formula is only for triangles #' where one vertex is the origin (0,0). For each triangle of the #' \code{\link[gpclib]{tristrip}} we have to check in which of the 6 outer #' regions of the triangle the origin (0,0) lies and adapt the signs in the #' formula appropriately. (AOB+BOC-AOC) or (AOB-AOC-BOC) or (AOB+AOC-BOC) or #' (AOC+BOC-AOB) or \ldots. However, the most time consuming step is the #' evaluation of \code{\link[mvtnorm]{pmvnorm}}. #' #' @note The package \pkg{gpclib} (which is required to produce the #' \code{tristrip}, since this is not yet implemented in \pkg{rgeos}) #' has a restricted license (commercial use prohibited). #' It has to be accepted explicitly via #' \code{\link{gpclibPermit}()} prior to using \code{polyCub.exact.Gauss}. #' #' @param polyregion a \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} polygon or #' something that can be coerced to this class, e.g., an \code{"owin"} polygon #' (converted via \code{\link{owin2gpc}} and -- given \pkg{rgeos} is available #' -- \code{"SpatialPolygons"} also work. #' @param mean,Sigma mean and covariance matrix of the bivariate normal density #' to be integrated. #' @param plot logical indicating if an illustrative plot of the numerical #' integration should be produced. Note that the \code{polyregion} will be #' shifted and scaled. #' @return The integral of the bivariate normal density over \code{polyregion}. #' Two attributes are appended to the integral value: #' \item{nEval}{ #' number of triangles over which the standard bivariate normal density had to #' be integrated, i.e. number of calls to \code{\link[mvtnorm]{pmvnorm}} and #' \code{\link[stats]{pnorm}}, the former of which being the most time-consuming #' operation. #' } #' \item{error}{ #' Approximate absolute integration error steming from the error introduced by #' the \code{nEval} \code{\link[mvtnorm]{pmvnorm}} evaluations. #' For this reason, the cubature method is in fact only #' quasi-exact (as is the \code{pmvnorm} function). #' } #' @references #' M. Abramowitz and I. A. Stegun (1970). #' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical #' Tables (9th ed.). New York: Dover Publications. #' @keywords math spatial #' @seealso \code{\link{circleCub.Gauss}} for quasi-exact cubature of the #' isotropic Gaussian density over a circular domain. #' @family polyCub-methods #' @examples # see example(polyCub) #' @import methods #' @import sp #' @importFrom stats cov2cor #' @importFrom spatstat is.polygonal #' @export polyCub.exact.Gauss <- function (polyregion, mean = c(0,0), Sigma = diag(2), plot = FALSE) { gpclibCheck() if (is.polygonal(polyregion)) { polyregion <- owin2gpc(polyregion) } else if (!inherits(polyregion, "gpc.poly")) { loadNamespace("rgeos") polyregion <- as(polyregion, "gpc.poly") } ## coordinate transformation so that the standard bivariat normal density ## can be used in integrations (cf. formula 26.3.22) rho <- cov2cor(Sigma)[1,2] sdx <- sqrt(Sigma[1,1]) sdy <- sqrt(Sigma[2,2]) polyregion@pts <- lapply(polyregion@pts, function (poly) { list(x = ((poly$x-mean[1])/sdx + (poly$y-mean[2])/sdy) / sqrt(2+2*rho), y = ((poly$y-mean[2])/sdy - (poly$x-mean[1])/sdx) / sqrt(2-2*rho), hole = poly$hole) }) ## triangulation: tristrip() returns a list where each element is a ## coordinate matrix of vertices of triangles triangleSets <- gpclib::tristrip(polyregion) ### ILLUSTRATION ### if (plot) { plot(polyregion, poly.args=list(lwd=2), ann=FALSE) lapply(triangleSets, lines, lty=2) } #################### integrals <- sapply(triangleSets, function (triangles) { int <- 0 error <- 0 nTriangles <- nrow(triangles) - 2 for (i in seq_len(nTriangles)) { res <- .intTriangleAS(triangles[i+(0:2),]) err <- attr(res, "error") int <- int + res if (length(err) == 1L) error <- error + err ##<- sometimes err==numeric(0) (probably meaning err=0) } c(int, nTriangles, error) }) int <- sum(integrals[1,]) ## number of .V() evaluations ## (if 'h' in .intTriangleAS0 was always different from 0) attr(int, "nEval") <- 6 * sum(integrals[2,]) ## approximate absolute integration error attr(int, "error") <- sum(integrals[3,]) return(int) } ########################### ### Auxiliary Functions ### ########################### ## calculates the integral of the standard bivariat normal over a triangle ABC .intTriangleAS <- function (xy) { A <- xy[1,] B <- xy[2,] C <- xy[3,] intAOB <- .intTriangleAS0(A, B) intBOC <- .intTriangleAS0(B, C) intAOC <- .intTriangleAS0(A, C) # determine signs of integrals signAOB <- -1 + 2*.pointsOnSameSide(A,B,C) signBOC <- -1 + 2*.pointsOnSameSide(B,C,A) signAOC <- -1 + 2*.pointsOnSameSide(A,C,B) int <- signAOB*intAOB + signBOC*intBOC + signAOC*intAOC attr(int, "error") <- attr(intAOB, "error") + attr(intBOC, "error") + attr(intAOC, "error") return(int) } ## calculates the integral of the standard bivariat normal over a triangle A0B .intTriangleAS0 <- function (A, B) { d <- sqrt(sum((B-A)^2)) h <- abs(B[2]*A[1] - A[2]*B[1]) / d if (h == 0) return(0) k1 <- abs(A[1]*(B[1]-A[1]) + A[2]*(B[2]-A[2])) / d k2 <- abs(B[1]*(B[1]-A[1]) + B[2]*(B[2]-A[2])) / d V2 <- .V(h, k2) V1 <- .V(h, k1) res <- if (isTRUE(all.equal(k1+k2, d))) V2 + V1 else if (isTRUE(all.equal(abs(k2-k1), d))) abs(V2 - V1) else stop("something went wrong...") attr(res, "error") <- attr(V1, "error") + attr(V2, "error") return(res) } ## checks if point1 and point2 lie on the same side of a line through ## linepoint1 and linepoint2 .pointsOnSameSide <- function (linepoint1, linepoint2, point1, point2 = c(0,0)) { n <- c(-1,1) * rev(linepoint2-linepoint1) # normal vector S <- dotprod(point1-linepoint1,n) * dotprod(point2-linepoint1,n) return(S > 0) } ## calculates the integral of the standard bivariat normal ## over a triangle bounded by y=0, y=ax, x=h (cf. formula 26.3.23) ##' @importFrom stats pnorm .V <- function(h,k) { a <- k/h rho <- -a/sqrt(1+a^2) # V = 0.25 + L(h,0,rho) - L(0,0,rho) - Q(h) / 2 # L(0,0,rho) = 0.25 + asin(rho) / (2*pi) # V = L(h,0,rho) - asin(rho)/(2*pi) - Q(h) / 2 Lh0rho <- mvtnorm::pmvnorm( lower = c(h,0), upper = c(Inf,Inf), mean = c(0,0), corr = matrix(c(1,rho,rho,1),2,2) ) Qh <- pnorm(h, mean = 0, sd = 1, lower.tail = FALSE) return(Lh0rho - asin(rho)/2/pi - Qh/2) } polyCub/R/plotpolyf.R0000644000176000001440000000544312236770266014314 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2013 Sebastian Meyer ### Time-stamp: <[plotpolyf.R] by SM Don 07/11/2013 20:57 (CET)> ### ### Plot polygonal domain with image of bivariate function ################################################################################ ##' Plot Polygonal Domain on Image of Bivariate Function ##' ##' Produces a combined plot of a polygonal domain and an image of a bivariate ##' function, using either \code{\link[lattice:levelplot]{lattice::levelplot}} ##' or \code{\link{image}}. ##' ##' @inheritParams polyCub.SV ##' @param npixel numeric vector of length 1 or 2 setting the number of pixels ##' in each dimension. ##' @param cuts number of cut points in the \eqn{z} dimension. ##' The range of function values will be divided into \code{cuts+1} levels. ##' @param col colour vector used for the function levels. ##' @param lwd line width of the polygon edges. ##' @param xlim,ylim numeric vectors of length 2 setting the axis limits. ##' \code{NULL} means using the bounding box of \code{polyregion}. ##' @param use.lattice logical indicating if \pkg{lattice} graphics ##' (\code{\link[lattice]{levelplot}}) should be used. ##' @author Sebastian Meyer ##' @keywords hplot ##' @example inst/examples/plotpolyf.R ##' @importFrom grDevices extendrange heat.colors ##' @importFrom graphics image ##' @export plotpolyf <- function (polyregion, f, ..., npixel=100, cuts=15, col=rev(heat.colors(cuts+1)), lwd=3, xlim=NULL, ylim=NULL, use.lattice=TRUE) { polys <- xylist(polyregion) npixel <- rep(npixel, length.out=2) ## make two-dimensional grid if (is.null(xlim)) xlim <- extendrange(unlist(lapply(polys, "[[", "x"), use.names=FALSE)) if (is.null(ylim)) ylim <- extendrange(unlist(lapply(polys, "[[", "y"), use.names=FALSE)) xgrid <- makegrid(xlim, npixel[1]) ygrid <- makegrid(ylim, npixel[2]) xygrid <- expand.grid(x=xgrid, y=ygrid, KEEP.OUT.ATTRS=FALSE) ## compute function values on the grid xygrid$fval <- f(xygrid, ...) ## plot if (use.lattice && require("lattice")) { mypanel <- function(...) { panel.levelplot(...) lapply(polys, function(xy) panel.polygon(xy, lwd=lwd)) } print(levelplot(fval ~ x*y, data=xygrid, aspect="iso", cuts=cuts, col.regions=col, panel=mypanel)) } else { image(xgrid, ygrid, matrix(xygrid$fval, npixel[1], npixel[2]), col=col, xlab="x", ylab="y", asp=1) plot_polyregion(polyregion, lwd=lwd, add=TRUE) } } polyCub/R/tools.R0000644000176000001440000000645312250103750013406 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[tools.R] by SM Don 05/12/2013 15:04 (CET)> ### ### Tiny toolbox of internal function ################################################################################ ##' Check if Polygon is Closed ##' ##' Check if the first and last coordinates of a coordinate matrix are ##' identical. ##' @param coords numeric coordinate matrix. It is interpreted by ##' \code{\link{xy.coords}}. ##' @return logical ##' @keywords spatial internal ##' @importFrom grDevices xy.coords isClosed <- function (coords) { xycoords <- xy.coords(coords)[c("x","y")] n <- length(xycoords$x) return(identical(xycoords$x[1], xycoords$x[n]) && identical(xycoords$y[1], xycoords$y[n])) } ##' Dot/Scalar Product of Two Vectors ##' ##' This is nothing else than \code{sum(x*y)}. ##' @param x,y numeric vectors (of compatible lengths). ##' @return \code{sum(x*y)} ##' @keywords math internal dotprod <- function (x,y) sum(x*y) ##' Euclidean Vector Norm (Length) ##' ##' This is nothing else than \code{sqrt(sum(x^2))}. ##' @param x numeric vector. ##' @return \code{sqrt(sum(x^2))} ##' @keywords math internal vecnorm <- function (x) sqrt(sum(x^2)) ##' Checks if Argument is Scalar ##' ##' Check if the argument is scalar, i.e. a numeric vector of length 1. ##' @param x any object ##' @return logical ##' @keywords internal isScalar <- function (x) { length(x) == 1L && is.vector(x, mode = "numeric") } ##' Plots a Polygon (of Various Classes) ##' ##' @inheritParams polyCub.SV ##' @param lwd line width. ##' @param add logical. Add to existing plot? ##' @import methods ##' @import sp ##' @importFrom graphics polygon ##' @importFrom spatstat plot.owin ## CAVE: need to import plot.owin for compatibility with spatstat <1.33-0, ## since plot.owin was not registered as an S3-method for plot plot_polyregion <- function (polyregion, lwd=2, add=FALSE) { if (is.vector(polyregion, mode="list")) { # internal xylist object stopifnot(add) lapply(polyregion, function(xy) polygon(xy, lwd=lwd)) } else if (inherits(polyregion, "gpc.poly")) { if (!isClass("gpc.poly")) library("rgeos") plot(polyregion, poly.args=list(lwd=lwd), ann=FALSE, add=add) } else { if (inherits(polyregion, "Polygon")) polyregion <- Polygons(list(polyregion), "ID") if (inherits(polyregion, "Polygons")) polyregion <- SpatialPolygons(list(polyregion)) plot(polyregion, lwd=lwd, axes=TRUE, main="", add=add) } } ##' Constructs Equally-Spaced Grid ##' ##' Construct an equally-spaced grid given a range and the number of cut points ##' (one more than the number of resulting bins). ##' This is nothing else than \code{seq(range[1], range[2], length.out=n)}. ##' @param range numeric vector of length 2. ##' @param n length of the desired grid, i.e. number of bins + 1. ##' @return the desired grid, a numeric vector of length \code{n} covering ##' \code{range}. ##' @keywords internal makegrid <- function(range, n) seq(range[1], range[2], length.out=n) polyCub/R/coerce-gpc-methods.R0000644000176000001440000000574012236767637015744 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2012-2013 Sebastian Meyer ### Time-stamp: <[coerce-gpc-methods.R] by SM Don 07/11/2013 20:53 (CET)> ### ### Conversion from and to the "gpc.poly" class ################################################################################ ##' Conversion from and to the \code{"gpc.poly"} Class ##' ##' Package \pkg{polyCub} implements converters between the classes ##' \code{"\link[spatstat:owin.object]{owin}"} of package \pkg{spatstat} and ##' \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} of package \pkg{rgeos} ##' (originally from \pkg{gpclib}). ##' ##' @param object an object of class \code{"gpc.poly"} or \code{"owin"}, ##' respectively. ##' @return The converted polygon of class \code{"gpc.poly"} or \code{"owin"}, ##' respectively. If neither package \pkg{rgeos} nor \pkg{gpclib} are available, ##' \code{owin2gpc} will just return the \code{pts} slot of the ##' \code{"gpc.poly"} (no formal class) with a warning. ##' @author Sebastian Meyer\cr ##' The converters are slightly modified versions of the same functions in ##' \pkg{spatstat} version 1.33-0, authored by Adrian Baddeley and Rolf Turner. ##' (Note that support for the \code{"gpc.poly"} class was dropped from ##' \pkg{spatstat} as of version 1.34-0.) ##' @note The converter to \code{"gpc.poly"} requires the \pkg{rgeos} (or ##' \pkg{gpclib}) package for the formal class definition. It will produce ##' vertices ordered according to the \pkg{sp} convention, i.e. clockwise for ##' normal boundaries and anticlockwise for holes, where, however, the first ##' vertex is \emph{not} repeated! ##' @seealso \code{\link{xylist}}\cr ##' Conversions of \code{"gpc.poly"} objects from and to the ##' \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"} class of package ##' \pkg{sp} are available in the \pkg{rgeos} package. ##' @rdname coerce-gpc-methods ##' @keywords spatial methods ##' @importFrom spatstat as.polygonal is.hole.xypolygon ##' @import methods ##' @export owin2gpc <- function (object) { pts <- lapply(as.polygonal(object)$bdry, function (poly) { list(x = rev(poly$x), y = rev(poly$y), hole = is.hole.xypolygon(poly)) }) if (know_gpc.poly()) new("gpc.poly", pts = pts) else { warning("formal class \"gpc.poly\" not available") pts } } ##' @inheritParams owin2gpc ##' @rdname coerce-gpc-methods ##' @importFrom spatstat owin ##' @export gpc2owin <- function (object) owin(poly = xylist.gpc.poly(object)) ## check for the formal class "gpc.poly" (loading rgeos or gpclib if necessary) ##' @import methods know_gpc.poly <- function () { isClass("gpc.poly") || suppressWarnings(requireNamespace("rgeos", quietly=TRUE) || requireNamespace("gpclib", quietly=TRUE)) } polyCub/R/circleCub.R0000644000176000001440000000450712236766475014166 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2013 Sebastian Meyer ### Time-stamp: <[circleCub.R] by SM Don 07/11/2013 20:42 (CET)> ### ### Special cases of cubature over circular domains (center, r) ################################################################################ ##' Integration of the Isotropic Gaussian Density over Circular Domains ##' ##' This function calculates the integral of the bivariate, isotropic Gaussian ##' density (i.e. \eqn{\Sigma} = \code{sd^2*diag(2)}) over circular domains via ##' the cumulative distribution function of the (non-central) Chi-Squared ##' distribution (\code{pchisq}), cp. Formula 26.3.24 in Abramowitz and Stegun ##' (1970). ##' ##' @references ##' M. Abramowitz and I. A. Stegun (1970). ##' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical ##' Tables (9th ed.). New York: Dover Publications. ##' @param center numeric vector of length 2 (center of the circle). ##' @param r numeric (radius of the circle). Several radii may be supplied. ##' @param mean numeric vector of length 2 ##' (mean of the bivariate Gaussian density). ##' @param sd numeric (common standard deviation of the isotropic ##' Gaussian density in both dimensions). ##' @return The integral value (one for each supplied radius). ##' @note The non-centrality parameter of the evaluated chi-squared distribution ##' equals the squared distance between the \code{mean} and the ##' \code{center}. If this becomes too large, the result becomes inaccurate, see ##' \code{\link{pchisq}}. ##' @keywords math spatial ##' @importFrom stats pchisq ##' @export ##' @examples ##' circleCub.Gauss(center=c(1,2), r=3, mean=c(4,5), sd=6) ##' ##' if (gpclibPermit()) { ##' ## compare with cubature over a polygonal approximation of a circle ##' disc.poly <- spatstat::disc(radius=3, centre=c(1,2), npoly=32) ##' polyCub.exact.Gauss(disc.poly, mean=c(4,5), Sigma=6^2*diag(2)) ##' } circleCub.Gauss <- function (center, r, mean, sd) { stopifnot(isScalar(sd), length(center) == 2, length(mean) == 2) pchisq((r/sd)^2, df=2, ncp=sum(((center-mean)/sd)^2)) } polyCub/R/zzz.R0000644000176000001440000000770412236770020013107 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2009-2013 Sebastian Meyer ### Time-stamp: <[zzz.R] by SM Don 07/11/2013 20:54 (CET)> ### ### Package administration ################################################################################ #' Cubature over Polygonal Domains #' #' The \R package \pkg{polyCub} provides methods for \strong{cubature} #' (numerical integration) \strong{over polygonal domains}. #' The function \code{\link{polyCub}()} is the main entry point of the package. #' It is a wrapper around the specific cubature methods listed below. #' #' \describe{ #' \item{\code{\link{polyCub.midpoint}}:}{ #' Two-dimensional midpoint rule. #' Polygons are converted to binary pixel images #' using the \code{\link[spatstat]{as.im.function}} method from package #' \pkg{spatstat}. The integral is then obtained as the sum over (pixel area * #' f(pixel midpoint)). #' } #' \item{\code{\link{polyCub.SV}}:}{ #' Product Gauss cubature as proposed by Sommariva and Vianello (2007). #' } #' \item{\code{\link{polyCub.iso}}:}{ #' Efficient adaptive cubature for \emph{isotropic} functions via line #' \code{\link{integrate}()} along the polygon boundary. #' } #' \item{\code{\link{polyCub.exact.Gauss}}:}{ #' Quasi-exact method specific to the integration of the \emph{bivariate Gaussian #' density} over polygonal domains. It is based on formulae from Chapter 26 of #' the Abramowitz and Stegun (1970) handbook, i.e. triangulation of the #' polygonal domain (using \code{\link[gpclib]{tristrip}} of package #' \pkg{gpclib}) and appropriate evaluations of #' \code{\link[mvtnorm]{pmvnorm}} from package \pkg{mvtnorm}. #' Note that there is also a function \code{\link{circleCub.Gauss}} #' to perform integration of the \emph{isotropic} Gaussian density over #' \emph{circular domains}. #' } #' } #' See Section 3.2 of Meyer (2010) for a more detailed description and benchmark #' experiment of some of the above cubature methods (and others). #' #' @references #' M. Abramowitz and I. A. Stegun (1970). #' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical #' Tables (9th ed.). New York: Dover Publications. #' #' A. Baddeley and R. Turner (2005). #' Spatstat: an R package for analyzing spatial point patterns. #' Journal of Statistical Software 12 (6), 1-42. #' #' S. Meyer (2010). #' Spatio-Temporal Infectious Disease Epidemiology based on Point Processes. #' Master's Thesis, LMU Munich. #' Available as \url{http://epub.ub.uni-muenchen.de/11703/}. #' #' A. Sommariva and M. Vianello (2007). #' Product Gauss cubature over polygons based on Green's integration formula. #' Bit Numerical Mathematics, 47 (2), 441-453. #' @docType package #' @name polyCub-package #' @seealso The packages \pkg{cubature} and \pkg{R2Cuba}, which are more #' appropriate for cubature over simple hypercubes. NULL .Options <- new.env() .onLoad <- function (libname, pkgname) { .Options$gpclib <- FALSE } gpclibCheck <- function (fatal = TRUE) { gpclibOK <- .Options$gpclib if (!gpclibOK && fatal) { message("Note: The gpclib license is accepted by ", sQuote("gpclibPermit()"), ".") stop("acceptance of the gpclib license is required") } gpclibOK } ##' \pkg{gpclib} Licence Acceptance ##' ##' Similar to the handling in package \pkg{maptools}, these functions ##' explicitly accept the restricted \pkg{gpclib} licence (commercial use ##' prohibited) and report its acceptance status, respectively. ##' \pkg{gpclib} functionality is only required for ##' \code{\link{polyCub.exact.Gauss}}. ##' @export gpclibPermit <- function () { if (requireNamespace("gpclib")) .Options$gpclib <- TRUE gpclibPermitStatus() } ##' @rdname gpclibPermit ##' @export gpclibPermitStatus <- function () gpclibCheck(fatal=FALSE) polyCub/R/coerce-sp-methods.R0000644000176000001440000000535612236005553015576 0ustar ripleyusers################################################################################ ### Part of the R package "polyCub". ### Free software under the terms of the GNU General Public License, version 2, ### a copy of which is available at http://www.r-project.org/Licenses/. ### ### Copyright (C) 2012-2013 Sebastian Meyer ### Time-stamp: <[coerce-sp-methods.R] by SM Mon 04/11/2013 22:02 (CET)> ### ### Coerce "Polygons" to and from "owin" ################################################################################ ##' Coerce \code{"Polygons"} to \code{"owin"} ##' ##' Package \pkg{polyCub} also implements \code{coerce}-methods ##' (\code{as(object, Class)}) to convert ##' \code{"\link[sp:Polygons-class]{Polygons}"} ##' (or \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"} or ##' \code{"\link[sp:Polygon-class]{Polygon}"}) to ##' \code{"\link[spatstat:owin.object]{owin}"}. ##' @author Sebastian Meyer ##' @keywords spatial methods ##' @name coerce-sp-methods ##' @rdname coerce-sp-methods ##' @exportMethod coerce NULL ## Register "owin" as class in S4 so we can define methods for it ##setClass("owin") ## -> no need to register "owin", since we depend on sp which does it ! ## Otherwise we would get the following warning upon package installation: ## Warning in .simpleDuplicateClass(def, prev) : ## the specification for class "owin" in package 'polyCub' seems ## equivalent to one from package 'sp' and is not turning on ## duplicate class definitions for this class ## Using setOldClass("owin") is incompatible with package "maptools", which ## does setClass("owin") _and_ exports this class! Specifically, loading ## library("polyCub"); library("maptools"); library("gpclib") ## in this order would not work (no idea why) throwing: ## Error : package slot missing from signature for generic ‘plot’ ## and classes gpc.poly, ANY ## cannot use with duplicate class names (the package may need to be ## re-installed) ## Error: package/namespace load failed for ‘gpclib’ ##' @name coerce,SpatialPolygons,owin-method ##' @rdname coerce-sp-methods ##' @importFrom spatstat owin setAs(from = "SpatialPolygons", to = "owin", def = function (from) owin(poly=xylist.SpatialPolygons(from))) ##' @name coerce,Polygons,owin-method ##' @rdname coerce-sp-methods ##' @importFrom spatstat owin setAs(from = "Polygons", to = "owin", def = function (from) owin(poly=xylist.Polygons(from))) ##' @name coerce,Polygon,owin-method ##' @rdname coerce-sp-methods ##' @importFrom spatstat owin setAs(from = "Polygon", to = "owin", def = function (from) owin(poly=xylist.Polygon(from))) ##' @name coerce,Polygon,Polygons-method ##' @rdname coerce-sp-methods setAs(from = "Polygon", to = "Polygons", def = function (from) Polygons(list(from), "Polygon")) polyCub/MD50000644000176000001440000000377112250125023012227 0ustar ripleyusers7185f47a2a17ccb3d49e3bb6a513dcf9 *DESCRIPTION 8202c3e1da5544d2a942dbef2a4072b3 *NAMESPACE 88ac5e23078f7d92886d158a4e1b26e3 *R/circleCub.R b04c61543e6605e60891d4e76c595abb *R/coerce-gpc-methods.R 6a6a7f50b84c23f2e1a5cd506d07d571 *R/coerce-sp-methods.R 334547248c9807cae6ece0791d88f05f *R/plotpolyf.R 00f8503508c8fe19abb7e261193adff8 *R/polyCub.R 8f60e001ac1f78503b77b3b9015cfedd *R/polyCub.SV.R 1faf542239142da5bd04def658cc5b6f *R/polyCub.exact.Gauss.R 29ee60f0b21f6d3bd2454727d646fc7e *R/polyCub.iso.R e3d0a263bb4df532538cdea06242adb6 *R/polyCub.midpoint.R 5335433cc5a0930bd60ff00fe301fc76 *R/tools.R 9f31cfae70eaaf800f1056718a7b5a14 *R/xylist.R 2460ccad733adcb11684fb5a3150b7f6 *R/zzz.R 8a30d71be4f89aac7753fb0aa92cd01f *inst/NEWS.Rd a2e8c8c02633c62187d4b62c80ed7bde *inst/examples/plotpolyf.R e5804ff05c0c37610ad94d94759bfd32 *inst/examples/polyCub.R 29eddb3f94b94e9b590fbd757aaba763 *inst/examples/polyCub.iso.R 4946356cfcd0aa29cd9d13f373619af3 *inst/tests/test-polyCub.R 37e713535409ade74b9b3fa7f69eec5d *man/circleCub.Gauss.Rd 69b1d11e685024e614b632022f6dd64d *man/coerce-gpc-methods.Rd 345e899a2bb6ffc308b0f4b705a9a9fc *man/coerce-sp-methods.Rd ac65e7827a4dca7a25a444b385c869e6 *man/dotprod.Rd b9429722b428a77701210cde1f682f12 *man/gpclibPermit.Rd 4531be5a958f40abd9b4394a2735a8ae *man/isClosed.Rd 418943bd0a5fc1b93c1b962c5e4e492e *man/isScalar.Rd 7a669ac691ba13b1d926ae3c9c55cd51 *man/makegrid.Rd c3528d603db2362dc409d6e5ad2bbd8f *man/plot_polyregion.Rd b8a108919d5aa827cb936f85245a801a *man/plotpolyf.Rd 52b3d7fe480ad41bd117023d03d58468 *man/polyCub-package.Rd 9718fce0d04338339146479a4f9764bf *man/polyCub.Rd 199cc04dcd6848d324dfceda6e9b9426 *man/polyCub.SV.Rd cdc3501d92040417e4fc6509f4bd4a97 *man/polyCub.exact.Gauss.Rd 4a81dfa36b4950a196f9e48620dda0f5 *man/polyCub.iso.Rd d7de63314c1598a4dc6afc1eb5e0d60f *man/polyCub.midpoint.Rd 484cddcbf8e47e00d76d64e662c77113 *man/polygauss.Rd eca9ec2bc1465f8c9fc71b4cf84f9ab1 *man/vecnorm.Rd cc2d6af707de3e79e3476605eaaef276 *man/xylist.Rd f006a8b687ff8252a9b4e1c06f1565f2 *tests/test-all.R polyCub/DESCRIPTION0000644000176000001440000000312312250125023013414 0ustar ripleyusersPackage: polyCub Title: Cubature over Polygonal Domains Version: 0.4-1 Date: 2013-12-05 Authors@R: c(person("Sebastian", "Meyer", email = "Sebastian.Meyer@ifspm.uzh.ch", role = c("aut","cre","trl")), person("Michael", "Hoehle", email = "Michael.Hoehle@stat.uni-muenchen.de", role = c("ths"))) Description: A package providing methods for cubature (numerical integration) over polygonal domains. Currently, four cubature methods are implemented: the two-dimensional midpoint rule (a simple wrapper around spatstat::as.im.function), the product Gauss cubature proposed by Sommariva and Vianello (2007), an adaptive cubature for isotropic functions via line integrate() along the boundary, and quasi-exact methods specific to the integration of the bivariate Gaussian density over polygonal and circular domains. For cubature over simple hypercubes, the packages cubature and R2Cuba are more appropriate. License: GPL-2 URL: https://github.com/WastlM/polyCub BugReports: https://github.com/WastlM/polyCub/issues Depends: R (>= 2.15.0), methods, sp Imports: grDevices, graphics, stats, spatstat, statmod Suggests: lattice, testthat, mvtnorm, rgeos, gpclib Packaged: 2013-12-05 14:17:44 UTC; sebastian Author: Sebastian Meyer [aut, cre, trl], Michael Hoehle [ths] Maintainer: Sebastian Meyer NeedsCompilation: no Repository: CRAN Date/Publication: 2013-12-05 17:30:11 polyCub/man/0000755000176000001440000000000012236715210012471 5ustar ripleyuserspolyCub/man/coerce-gpc-methods.Rd0000644000176000001440000000323612234746723016447 0ustar ripleyusers\name{owin2gpc} \alias{gpc2owin} \alias{owin2gpc} \title{Conversion from and to the \code{"gpc.poly"} Class} \usage{ owin2gpc(object) gpc2owin(object) } \arguments{ \item{object}{an object of class \code{"gpc.poly"} or \code{"owin"}, respectively.} } \value{ The converted polygon of class \code{"gpc.poly"} or \code{"owin"}, respectively. If neither package \pkg{rgeos} nor \pkg{gpclib} are available, \code{owin2gpc} will just return the \code{pts} slot of the \code{"gpc.poly"} (no formal class) with a warning. } \description{ Package \pkg{polyCub} implements converters between the classes \code{"\link[spatstat:owin.object]{owin}"} of package \pkg{spatstat} and \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} of package \pkg{rgeos} (originally from \pkg{gpclib}). } \note{ The converter to \code{"gpc.poly"} requires the \pkg{rgeos} (or \pkg{gpclib}) package for the formal class definition. It will produce vertices ordered according to the \pkg{sp} convention, i.e. clockwise for normal boundaries and anticlockwise for holes, where, however, the first vertex is \emph{not} repeated! } \author{ Sebastian Meyer\cr The converters are slightly modified versions of the same functions in \pkg{spatstat} version 1.33-0, authored by Adrian Baddeley and Rolf Turner. (Note that support for the \code{"gpc.poly"} class was dropped from \pkg{spatstat} as of version 1.34-0.) } \seealso{ \code{\link{xylist}}\cr Conversions of \code{"gpc.poly"} objects from and to the \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"} class of package \pkg{sp} are available in the \pkg{rgeos} package. } \keyword{methods} \keyword{spatial} polyCub/man/dotprod.Rd0000644000176000001440000000044412142551047014437 0ustar ripleyusers\name{dotprod} \alias{dotprod} \title{Dot/Scalar Product of Two Vectors} \usage{ dotprod(x, y) } \arguments{ \item{x,y}{numeric vectors (of compatible lengths).} } \value{ \code{sum(x*y)} } \description{ This is nothing else than \code{sum(x*y)}. } \keyword{internal} \keyword{math} polyCub/man/polyCub.Rd0000644000176000001440000000665112236702210014401 0ustar ripleyusers\name{polyCub} \alias{polyCub} \title{Wrapper Function for the Various Cubature Methods} \usage{ polyCub(polyregion, f, method = c("SV", "midpoint", "iso", "exact.Gauss"), ..., plot = FALSE) } \arguments{ \item{polyregion}{a polygonal integration domain. The supported classes depend on the specific method, however, the \code{"\link[spatstat]{owin}"} class from package \pkg{spatstat} works for all methods, as well should a \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} polygon (but see the comments in \code{help("\link{coerce-methods}")}).} \item{f}{two-dimensional function to be integrated. As its first argument the function must take a coordinate matrix, i.e. a numeric matrix with two columns. For the \code{"exact.Gauss"} \code{method}, \code{f} is ignored since it is specific to the bivariate normal density.} \item{method}{choose one of the implemented cubature methods (partial argument matching is applied), see \code{help("\link{polyCub-package}")} for an overview. Defaults to using the product Gauss cubature implemented in \code{\link{polyCub.SV}}.} \item{...}{arguments of \code{f} or of the specific \code{method}.} \item{plot}{logical indicating if an illustrative plot of the numerical integration should be produced.} } \value{ The approximated integral of \code{f} over \code{polyregion}. } \description{ Instead of calling one of the specific cubature methods of this package, the wrapper function \code{polyCub} may be used together with the \code{method} argument. } \examples{ ### Short comparison of the different cubature methods ## 2D-function to integrate (here: isotropic zero-mean Gaussian density) f <- function (s, sigma = 5) exp(-rowSums(s^2)/2/sigma^2) / (2*pi*sigma^2) ## simple polygonal integration domain disc.owin <- spatstat::disc(radius=5, centre=c(3,2), npoly=8) ## plot image of the function and integration domain plotpolyf(disc.owin, f, xlim=c(-8,8), ylim=c(-8,8)) ### Quasi-exact cubature of the bivariate Gaussian density ### using gpclib::tristrip and mvtnorm::pmvnorm() if (requireNamespace("mvtnorm") && gpclibPermit()) { print(polyCub.exact.Gauss(disc.owin, mean=c(0,0), Sigma=5^2*diag(2), plot=TRUE), digits=16) } ### Two-dimensional midpoint rule testmidpoint <- function (eps, main=paste("2D midpoint rule with eps =",eps)) { plotpolyf(disc.owin, f, xlim=c(-8,8), ylim=c(-8,8), use.lattice=FALSE) ## add evaluation points to plot with(spatstat::as.mask(disc.owin, eps=eps), points(expand.grid(xcol, yrow), col=m, pch=20)) polyCub.midpoint(disc.owin, f, eps=eps) } testmidpoint(5) testmidpoint(3) testmidpoint(0.5) testmidpoint(0.2) ### Product Gauss cubature using an increasing number of nodes for (nGQ in c(1:5,10,20,60)) { cat("nGQ =", sprintf("\%2i",nGQ), ": ", format(polyCub.SV(disc.owin, f, nGQ=nGQ), digits=16), "\\n") } ## 'rotation' affects location of nodes opar <- par(mfrow=c(1,2)) polyCub.SV(disc.owin, f, nGQ=2, rotation=FALSE, plot=TRUE) polyCub.SV(disc.owin, f, nGQ=2, rotation=TRUE, plot=TRUE) par(opar) ### Line integration along the boundary for isotropic functions polyCub.iso(disc.owin, f, center=c(0,0)) # see ?polyCub.iso } \seealso{ Other polyCub.methods: \code{\link{.polyCub.iso}}, \code{\link{polyCub.SV}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.iso}}, \code{\link{polyCub.midpoint}} } \keyword{math} \keyword{spatial} polyCub/man/plot_polyregion.Rd0000644000176000001440000000121212166024350016201 0ustar ripleyusers\name{plot_polyregion} \alias{plot_polyregion} \title{Plots a Polygon (of Various Classes)} \usage{ plot_polyregion(polyregion, lwd = 2, add = FALSE) } \arguments{ \item{lwd}{line width.} \item{add}{logical. Add to existing plot?} \item{polyregion}{a polygonal integration domain. The following classes are supported: \code{"\link[spatstat]{owin}"}, \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"}, \code{"\linkS4class{SpatialPolygons}"}, \code{"\linkS4class{Polygons}"}, and \code{"\linkS4class{Polygon}"} (for these we have an internal \code{\link{xylist}} method).} } \description{ Plots a Polygon (of Various Classes) } polyCub/man/vecnorm.Rd0000644000176000001440000000041712155744464014450 0ustar ripleyusers\name{vecnorm} \alias{vecnorm} \title{Euclidean Vector Norm (Length)} \usage{ vecnorm(x) } \arguments{ \item{x}{numeric vector.} } \value{ \code{sqrt(sum(x^2))} } \description{ This is nothing else than \code{sqrt(sum(x^2))}. } \keyword{internal} \keyword{math} polyCub/man/polyCub-package.Rd0000644000176000001440000000501412236766241016000 0ustar ripleyusers\docType{package} \name{polyCub-package} \alias{polyCub-package} \title{Cubature over Polygonal Domains} \description{ The \R package \pkg{polyCub} provides methods for \strong{cubature} (numerical integration) \strong{over polygonal domains}. The function \code{\link{polyCub}()} is the main entry point of the package. It is a wrapper around the specific cubature methods listed below. } \details{ \describe{ \item{\code{\link{polyCub.midpoint}}:}{ Two-dimensional midpoint rule. Polygons are converted to binary pixel images using the \code{\link[spatstat]{as.im.function}} method from package \pkg{spatstat}. The integral is then obtained as the sum over (pixel area * f(pixel midpoint)). } \item{\code{\link{polyCub.SV}}:}{ Product Gauss cubature as proposed by Sommariva and Vianello (2007). } \item{\code{\link{polyCub.iso}}:}{ Efficient adaptive cubature for \emph{isotropic} functions via line \code{\link{integrate}()} along the polygon boundary. } \item{\code{\link{polyCub.exact.Gauss}}:}{ Quasi-exact method specific to the integration of the \emph{bivariate Gaussian density} over polygonal domains. It is based on formulae from Chapter 26 of the Abramowitz and Stegun (1970) handbook, i.e. triangulation of the polygonal domain (using \code{\link[gpclib]{tristrip}} of package \pkg{gpclib}) and appropriate evaluations of \code{\link[mvtnorm]{pmvnorm}} from package \pkg{mvtnorm}. Note that there is also a function \code{\link{circleCub.Gauss}} to perform integration of the \emph{isotropic} Gaussian density over \emph{circular domains}. } } See Section 3.2 of Meyer (2010) for a more detailed description and benchmark experiment of some of the above cubature methods (and others). } \references{ M. Abramowitz and I. A. Stegun (1970). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables (9th ed.). New York: Dover Publications. A. Baddeley and R. Turner (2005). Spatstat: an R package for analyzing spatial point patterns. Journal of Statistical Software 12 (6), 1-42. S. Meyer (2010). Spatio-Temporal Infectious Disease Epidemiology based on Point Processes. Master's Thesis, LMU Munich. Available as \url{http://epub.ub.uni-muenchen.de/11703/}. A. Sommariva and M. Vianello (2007). Product Gauss cubature over polygons based on Green's integration formula. Bit Numerical Mathematics, 47 (2), 441-453. } \seealso{ The packages \pkg{cubature} and \pkg{R2Cuba}, which are more appropriate for cubature over simple hypercubes. } polyCub/man/polyCub.exact.Gauss.Rd0000644000176000001440000000565212234744265016603 0ustar ripleyusers\name{polyCub.exact.Gauss} \alias{polyCub.exact.Gauss} \title{Quasi-Exact Cubature of the Bivariate Normal Density} \usage{ polyCub.exact.Gauss(polyregion, mean = c(0, 0), Sigma = diag(2), plot = FALSE) } \arguments{ \item{polyregion}{a \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} polygon or something that can be coerced to this class, e.g., an \code{"owin"} polygon (converted via \code{\link{owin2gpc}} and -- given \pkg{rgeos} is available -- \code{"SpatialPolygons"} also work.} \item{mean,Sigma}{mean and covariance matrix of the bivariate normal density to be integrated.} \item{plot}{logical indicating if an illustrative plot of the numerical integration should be produced. Note that the \code{polyregion} will be shifted and scaled.} } \value{ The integral of the bivariate normal density over \code{polyregion}. Two attributes are appended to the integral value: \item{nEval}{ number of triangles over which the standard bivariate normal density had to be integrated, i.e. number of calls to \code{\link[mvtnorm]{pmvnorm}} and \code{\link[stats]{pnorm}}, the former of which being the most time-consuming operation. } \item{error}{ Approximate absolute integration error steming from the error introduced by the \code{nEval} \code{\link[mvtnorm]{pmvnorm}} evaluations. For this reason, the cubature method is in fact only quasi-exact (as is the \code{pmvnorm} function). } } \description{ Integration is based on triangulation of the polygonal domain and formulae from Chapter 26 of the Abramowitz & Stegun handbook (Section 26.9, Example 9, pp. 956f.). This method is quite cumbersome because the A&S formula is only for triangles where one vertex is the origin (0,0). For each triangle of the \code{\link[gpclib]{tristrip}} we have to check in which of the 6 outer regions of the triangle the origin (0,0) lies and adapt the signs in the formula appropriately. (AOB+BOC-AOC) or (AOB-AOC-BOC) or (AOB+AOC-BOC) or (AOC+BOC-AOB) or \ldots. However, the most time consuming step is the evaluation of \code{\link[mvtnorm]{pmvnorm}}. } \note{ The package \pkg{gpclib} (which is required to produce the \code{tristrip}, since this is not yet implemented in \pkg{rgeos}) has a restricted license (commercial use prohibited). It has to be accepted explicitly via \code{\link{gpclibPermit}()} prior to using \code{polyCub.exact.Gauss}. } \examples{ # see example(polyCub) } \references{ M. Abramowitz and I. A. Stegun (1970). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables (9th ed.). New York: Dover Publications. } \seealso{ \code{\link{circleCub.Gauss}} for quasi-exact cubature of the isotropic Gaussian density over a circular domain. Other polyCub.methods: \code{\link{.polyCub.iso}}, \code{\link{polyCub}}, \code{\link{polyCub.SV}}, \code{\link{polyCub.iso}}, \code{\link{polyCub.midpoint}} } \keyword{math} \keyword{spatial} polyCub/man/circleCub.Gauss.Rd0000644000176000001440000000322312236702210015730 0ustar ripleyusers\name{circleCub.Gauss} \alias{circleCub.Gauss} \title{Integration of the Isotropic Gaussian Density over Circular Domains} \usage{ circleCub.Gauss(center, r, mean, sd) } \arguments{ \item{center}{numeric vector of length 2 (center of the circle).} \item{r}{numeric (radius of the circle). Several radii may be supplied.} \item{mean}{numeric vector of length 2 (mean of the bivariate Gaussian density).} \item{sd}{numeric (common standard deviation of the isotropic Gaussian density in both dimensions).} } \value{ The integral value (one for each supplied radius). } \description{ This function calculates the integral of the bivariate, isotropic Gaussian density (i.e. \eqn{\Sigma} = \code{sd^2*diag(2)}) over circular domains via the cumulative distribution function of the (non-central) Chi-Squared distribution (\code{pchisq}), cp. Formula 26.3.24 in Abramowitz and Stegun (1970). } \note{ The non-centrality parameter of the evaluated chi-squared distribution equals the squared distance between the \code{mean} and the \code{center}. If this becomes too large, the result becomes inaccurate, see \code{\link{pchisq}}. } \examples{ circleCub.Gauss(center=c(1,2), r=3, mean=c(4,5), sd=6) if (gpclibPermit()) { ## compare with cubature over a polygonal approximation of a circle disc.poly <- spatstat::disc(radius=3, centre=c(1,2), npoly=32) polyCub.exact.Gauss(disc.poly, mean=c(4,5), Sigma=6^2*diag(2)) } } \references{ M. Abramowitz and I. A. Stegun (1970). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables (9th ed.). New York: Dover Publications. } \keyword{math} \keyword{spatial} polyCub/man/polyCub.midpoint.Rd0000644000176000001440000000317712155744464016244 0ustar ripleyusers\name{polyCub.midpoint} \alias{polyCub.midpoint} \title{Two-Dimensional Midpoint Rule} \usage{ polyCub.midpoint(polyregion, f, ..., eps = NULL, dimyx = NULL, plot = FALSE) } \arguments{ \item{polyregion}{a polygonal integration domain. It can be any object coercible to the \pkg{spatstat} class \code{"\link[spatstat]{owin}"} (via \code{\link[spatstat]{as.owin}}).} \item{f}{two-dimensional function to be integrated. As its first argument the function must take a coordinate matrix, i.e. a numeric matrix with two columns.} \item{...}{further arguments for \code{f}.} \item{eps}{width and height of the pixels (squares), see \code{\link[spatstat]{as.mask}}.} \item{dimyx}{number of subdivisions in each dimension, see \code{\link[spatstat]{as.mask}}.} \item{plot}{logical indicating if an illustrative plot of the numerical integration should be produced.} } \value{ The approximated value of the integral of \code{f} over \code{polyregion}. } \description{ The surface is converted to a binary pixel image using the \code{\link[spatstat]{as.im.function}} method from package \pkg{spatstat}. The integral under the surface is then approximated as the sum over (pixel area * f(pixel midpoint)). } \examples{ # see example(polyCub) } \references{ A. Baddeley and R. Turner (2005). Spatstat: an R package for analyzing spatial point patterns. Journal of Statistical Software 12 (6), 1-42. } \seealso{ Other polyCub.methods: \code{\link{.polyCub.iso}}, \code{\link{polyCub}}, \code{\link{polyCub.SV}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.iso}} } \keyword{math} \keyword{spatial} polyCub/man/polyCub.iso.Rd0000644000176000001440000001070412236706253015177 0ustar ripleyusers\name{polyCub.iso} \alias{.polyCub.iso} \alias{polyCub.iso} \title{Cubature of Isotropic Functions over Polygonal Domains} \usage{ polyCub.iso(polyregion, f, intrfr, ..., center, control = list(), check.intrfr = FALSE, plot = FALSE) .polyCub.iso(polys, intrfr, ..., center, control = list(), .witherror = FALSE) } \arguments{ \item{intrfr}{analytical antiderivative of \eqn{r f_r(r)} from 0 to \code{R} (first argument, not necessarily named \code{"R"}, must be vectorized). If given, \code{f} is not required (except for plotting)! If missing, \code{intrfr} is approximated numerically, again using \code{\link{integrate}}.} \item{...}{further arguments for \code{f} or \code{intrfr}.} \item{center}{numeric vector of length 2, the center of isotropy.} \item{control}{list of arguments passed to \code{\link{integrate}}, the quadrature rule used for the line integral along the polygon boundary.} \item{check.intrfr}{logical (or numeric vector) indicating if (for which \code{r}'s) the supplied \code{intrfr} function should be checked against a numeric approximation. If \code{TRUE}, the set of test \code{r}'s defaults to a \code{\link{seq}} of length 20 from 1 to the maximum absolute x or y coordinate of any edge of the \code{polyregion}.} \item{polys}{something like \code{owin$bdry}, but see \code{\link{xylist}}.} \item{.witherror}{logical indicating if an upperbound for the absolute integration error should be attached as an attribute to the result?} \item{polyregion}{a polygonal integration domain. The following classes are supported: \code{"\link[spatstat]{owin}"}, \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"}, \code{"\linkS4class{SpatialPolygons}"}, \code{"\linkS4class{Polygons}"}, and \code{"\linkS4class{Polygon}"} (for these we have an internal \code{\link{xylist}} method).} \item{f}{two-dimensional function. As its first argument it must take a coordinate matrix, i.e. a numeric matrix with two columns.} \item{plot}{logical indicating if an illustrative plot of the numerical integration should be produced.} } \value{ The approximate integral of the isotropic function \code{f} over \code{polyregion}.\cr If the \code{intrfr} function is provided (which is assumed to be exact), an upperbound for the absolute integration error is appended to the result as attribute \code{"abs.error"}. It equals the sum of the absolute errors reported by all \code{\link{integrate}} calls (there is one for each edge of \code{polyregion}). } \description{ Conducts numerical integration of a two-dimensional isotropic function \eqn{f(x,y) = f_r(||(x,y)-\boldsymbol{\mu}||)}{f(x,y) = f_r(||(x,y)-\mu||)} with \eqn{\mu} being the center of isotropy, over a polygonal domain. It internally solves a line integral along the polygon boundary using \code{\link{integrate}} where the integrand requires the antiderivative of \eqn{r f_r(r)}), which ideally is analytically available and supplied to the function as argument \code{intrfr}. The two-dimensional integration problem thereby reduces to an efficient adaptive quadrature in one dimension. \code{.polyCub.iso} is a \dQuote{bare-bone} version of \code{polyCub.iso}. } \examples{ ## we use the example polygon and f (exponential decay) from example(plotpolyf) ## numerical approximation of 'intrfr' (intISOnum <- polyCub.iso(letterR, f, center=fcenter)) ## analytical 'intrfr' (recall: f_r(r)=dexp(r), we need int_0^R r*f(r) dr) intrfr <- function (R, rate=1) pgamma(R, 2, rate) / rate (intISOana <- polyCub.iso(letterR, intrfr=intrfr, center=fcenter)) stopifnot(all.equal(intISOana, intISOnum, check.attributes=FALSE)) ### polygon area: f(r) = 1, f(x,y) = 1, center does not really matter intrfr.const <- function (R) R^2/2 (area.ISO <- polyCub.iso(letterR, intrfr=intrfr.const, center=c(0,0))) stopifnot(all.equal(spatstat::area.owin(letterR), area.ISO, check.attributes=FALSE)) ## the hole region is subtracted correctly } \author{ Sebastian Meyer The basic idea for this cubature rule is due to Emil Hedevang (2013), Dept. of Mathematics, Aarhus University, Denmark } \references{ E. Hedevang (2013). Personal communication at the Summer School on Topics in Space-Time Modeling and Inference (May 2013, Aalborg, Denmark). } \seealso{ Other polyCub.methods: \code{\link{polyCub}}, \code{\link{polyCub.SV}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.midpoint}} } \keyword{math} \keyword{spatial} polyCub/man/xylist.Rd0000644000176000001440000000660612236702210014320 0ustar ripleyusers\name{xylist} \alias{xylist} \alias{xylist.Polygon} \alias{xylist.Polygons} \alias{xylist.SpatialPolygons} \alias{xylist.default} \alias{xylist.gpc.poly} \alias{xylist.owin} \title{Convert Various Polygon Classes to a Simple List of Vertices} \usage{ xylist(object, ...) \method{xylist}{owin} (object, ...) \method{xylist}{gpc.poly} (object, ...) \method{xylist}{SpatialPolygons} (object, reverse = TRUE, ...) \method{xylist}{Polygons} (object, reverse = TRUE, ...) \method{xylist}{Polygon} (object, reverse = TRUE, ...) \method{xylist}{default} (object, ...) } \arguments{ \item{object}{an object of one of the supported spatial classes.} \item{...}{(unused) argument of the generic.} \item{reverse}{logical (\code{TRUE}) indicating if the vertex order of the \pkg{sp} classes should be reversed to get the \code{xylist}/\code{owin} convention.} } \value{ Applying \code{xylist} to a polygon object, one gets a simple list, where each component (polygon) is a list of \code{"x"} and \code{"y"} coordinates. These represent vertex coordinates following \pkg{spatstat}'s \code{"owin"} convention (anticlockwise order without repeating any vertex). The opposite vertex order can be retained for the \pkg{sp}-classes by the non-default use with \code{reverse=FALSE}.\cr } \description{ Different packages concerned with spatial data use different polygon specifications, which sometimes becomes very confusing (see Details below). To be compatible with the various polygon classes, package \pkg{polyCub} uses an S3 class \code{"xylist"}, which represents polygons by their core feature only, a list of lists of vertex coordinates (see the "Value" section below). The generic function \code{xylist} can deal with the following polygon classes: \itemize{ \item{\code{"\link[spatstat:owin.object]{owin}"} from package \pkg{spatstat}} \item{\code{"\link[rgeos:gpc.poly-class]{gpc.poly}"} from package \pkg{rgeos} (or \pkg{gpclib})} \item{\code{"\link[sp:Polygons-class]{Polygons}"} from package \pkg{sp} (as well as \code{"\link[sp:Polygon-class]{Polygon}"} and \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"})} } The (somehow useless) default \code{xylist}-method does not perform any transformation but only ensures that the polygons are not closed (first vertex not repeated). } \details{ Different packages concerned with spatial data use different polygon specifications with respect to: \itemize{ \item{do we repeat the first vertex?} \item{which direction represents holes?} } Package overview: \describe{ \item{\pkg{sp}:}{\emph{Repeat} first vertex at the end (closed), anticlockwise = hole, clockwise = normal boundary} \item{\pkg{spatstat}:}{do \emph{not repeat} first vertex, anticlockwise = normal boundary, clockwise = hole. This convention is also used in \code{xylist}.} \item{\pkg{gpclib}:}{Unfortunately, there seems to be no convention for the specification of polygons of class \code{"gpc.poly"}.} } } \author{ Sebastian Meyer\cr The implementation of the \code{"gpc.poly"}-method of \code{xylist} depends on functionality of the \pkg{spatstat} package and borrows large parts from the function \code{gpc2owin} (as implemented in package \pkg{spatstat} before version 1.34-0, when support for \code{"gpc.poly"} was dropped) authored by Adrian Baddeley and Rolf Turner. } \keyword{methods} \keyword{spatial} polyCub/man/makegrid.Rd0000644000176000001440000000105612166024350014545 0ustar ripleyusers\name{makegrid} \alias{makegrid} \title{Constructs Equally-Spaced Grid} \usage{ makegrid(range, n) } \arguments{ \item{range}{numeric vector of length 2.} \item{n}{length of the desired grid, i.e. number of bins + 1.} } \value{ the desired grid, a numeric vector of length \code{n} covering \code{range}. } \description{ Construct an equally-spaced grid given a range and the number of cut points (one more than the number of resulting bins). This is nothing else than \code{seq(range[1], range[2], length.out=n)}. } \keyword{internal} polyCub/man/polygauss.Rd0000644000176000001440000000343212210125651015004 0ustar ripleyusers\name{polygauss} \alias{polygauss} \title{Calculate 2D Nodes and Weights of the Product Gauss Cubature} \usage{ polygauss(xy, nw_MN, alpha = NULL, rotation = FALSE) } \arguments{ \item{xy}{list with elements \code{"x"} and \code{"y"} containing the polygon vertices in \emph{anticlockwise} order (otherwise the result of the cubature will have a negative sign) with first vertex not repeated at the end (like \code{owin.object$bdry}).} \item{nw_MN}{unnamed list of nodes and weights of one-dimensional Gauss quadrature rules of degrees \eqn{N} and \eqn{M=N+1} (as returned by \code{\link[statmod]{gauss.quad}}): \code{list(s_M, w_M, s_N, w_N)}.} \item{alpha}{base-line of the (rotated) polygon at \eqn{x = \alpha} (see Sommariva and Vianello (2007) for an explication). If \code{NULL} (default), the midpoint of the x-range of the polygon is chosen if no \code{rotation} is performed, and otherwise the \eqn{x}-coordinate of the rotated point \code{"P"}. If \code{f} has its maximum value at the origin \eqn{(0,0)}, e.g., the bivariate Gaussian density with zero mean, \code{alpha = 0} is a reasonable choice.} \item{rotation}{logical (default: \code{FALSE}) or a list of points \code{"P"} and \code{"Q"} describing the preferred direction. If \code{TRUE}, the polygon is rotated according to the vertices \code{"P"} and \code{"Q"}, which are farthest apart (see Sommariva and Vianello, 2007). For convex polygons, this rotation guarantees that all nodes fall inside the polygon.} } \description{ Calculate 2D Nodes and Weights of the Product Gauss Cubature } \references{ A. Sommariva and M. Vianello (2007): Product Gauss cubature over polygons based on Green's integration formula. Bit Numerical Mathematics, 47 (2), 441-453. } \keyword{internal} polyCub/man/plotpolyf.Rd0000644000176000001440000000372312236702210015011 0ustar ripleyusers\name{plotpolyf} \alias{plotpolyf} \title{Plot Polygonal Domain on Image of Bivariate Function} \usage{ plotpolyf(polyregion, f, ..., npixel = 100, cuts = 15, col = rev(heat.colors(cuts + 1)), lwd = 3, xlim = NULL, ylim = NULL, use.lattice = TRUE) } \arguments{ \item{npixel}{numeric vector of length 1 or 2 setting the number of pixels in each dimension.} \item{cuts}{number of cut points in the \eqn{z} dimension. The range of function values will be divided into \code{cuts+1} levels.} \item{col}{colour vector used for the function levels.} \item{lwd}{line width of the polygon edges.} \item{xlim,ylim}{numeric vectors of length 2 setting the axis limits. \code{NULL} means using the bounding box of \code{polyregion}.} \item{use.lattice}{logical indicating if \pkg{lattice} graphics (\code{\link[lattice]{levelplot}}) should be used.} \item{polyregion}{a polygonal integration domain. The following classes are supported: \code{"\link[spatstat]{owin}"}, \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"}, \code{"\linkS4class{SpatialPolygons}"}, \code{"\linkS4class{Polygons}"}, and \code{"\linkS4class{Polygon}"} (for these we have an internal \code{\link{xylist}} method).} \item{f}{two-dimensional function. As its first argument it must take a coordinate matrix, i.e. a numeric matrix with two columns.} \item{...}{further arguments for \code{f}.} } \description{ Produces a combined plot of a polygonal domain and an image of a bivariate function, using either \code{\link[lattice:levelplot]{lattice::levelplot}} or \code{\link{image}}. } \examples{ ### a polygonal domain data("letterR", package="spatstat") ### f: isotropic exponential decay fr <- function(r, rate=1) dexp(r, rate=rate) fcenter <- c(2,3) f <- function (s, rate=1) fr(sqrt(rowSums(t(t(s)-fcenter)^2)), rate=rate) ### plot plotpolyf(letterR, f, use.lattice=FALSE) plotpolyf(letterR, f, use.lattice=TRUE) } \author{ Sebastian Meyer } \keyword{hplot} polyCub/man/gpclibPermit.Rd0000644000176000001440000000072412142545276015415 0ustar ripleyusers\name{gpclibPermit} \alias{gpclibPermit} \alias{gpclibPermitStatus} \title{\pkg{gpclib} Licence Acceptance} \usage{ gpclibPermit() gpclibPermitStatus() } \description{ Similar to the handling in package \pkg{maptools}, these functions explicitly accept the restricted \pkg{gpclib} licence (commercial use prohibited) and report its acceptance status, respectively. \pkg{gpclib} functionality is only required for \code{\link{polyCub.exact.Gauss}}. } polyCub/man/polyCub.SV.Rd0000644000176000001440000000541412166024350014730 0ustar ripleyusers\name{polyCub.SV} \alias{polyCub.SV} \title{Product Gauss Cubature over Polygonal Domains} \usage{ polyCub.SV(polyregion, f, ..., nGQ = 20, alpha = NULL, rotation = FALSE, plot = FALSE) } \arguments{ \item{polyregion}{a polygonal integration domain. The following classes are supported: \code{"\link[spatstat]{owin}"}, \code{"\link[rgeos:gpc.poly-class]{gpc.poly}"}, \code{"\linkS4class{SpatialPolygons}"}, \code{"\linkS4class{Polygons}"}, and \code{"\linkS4class{Polygon}"} (for these we have an internal \code{\link{xylist}} method).} \item{f}{two-dimensional function. As its first argument it must take a coordinate matrix, i.e. a numeric matrix with two columns.} \item{...}{further arguments for \code{f}.} \item{nGQ}{degree of the one-dimensional Gauss-Legendre quadrature rule (default: 20). See \code{\link[statmod]{gauss.quad}} in package \pkg{statmod}, on which this function depends.} \item{plot}{logical indicating if an illustrative plot of the numerical integration should be produced.} \item{alpha}{base-line of the (rotated) polygon at \eqn{x = \alpha} (see Sommariva and Vianello (2007) for an explication). If \code{NULL} (default), the midpoint of the x-range of the polygon is chosen if no \code{rotation} is performed, and otherwise the \eqn{x}-coordinate of the rotated point \code{"P"}. If \code{f} has its maximum value at the origin \eqn{(0,0)}, e.g., the bivariate Gaussian density with zero mean, \code{alpha = 0} is a reasonable choice.} \item{rotation}{logical (default: \code{FALSE}) or a list of points \code{"P"} and \code{"Q"} describing the preferred direction. If \code{TRUE}, the polygon is rotated according to the vertices \code{"P"} and \code{"Q"}, which are farthest apart (see Sommariva and Vianello, 2007). For convex polygons, this rotation guarantees that all nodes fall inside the polygon.} } \value{ The approximated value of the integral of \code{f} over \code{polyregion}. } \description{ Product Gauss cubature over polygons as proposed by Sommariva and Vianello (2007). } \examples{ # see example(polyCub) } \author{ Sebastian Meyer\cr The product Gauss cubature is based on the original \acronym{MATLAB} implementation \code{polygauss} by Sommariva and Vianello (2007), which is available under the GNU GPL (>=2) license from \url{http://www.math.unipd.it/~alvise/software.html}. } \references{ A. Sommariva and M. Vianello (2007). Product Gauss cubature over polygons based on Green's integration formula. Bit Numerical Mathematics, 47 (2), 441-453. } \seealso{ Other polyCub.methods: \code{\link{.polyCub.iso}}, \code{\link{polyCub}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.iso}}, \code{\link{polyCub.midpoint}} } \keyword{math} \keyword{spatial} polyCub/man/isScalar.Rd0000644000176000001440000000040312142551047014520 0ustar ripleyusers\name{isScalar} \alias{isScalar} \title{Checks if Argument is Scalar} \usage{ isScalar(x) } \arguments{ \item{x}{any object} } \value{ logical } \description{ Check if the argument is scalar, i.e. a numeric vector of length 1. } \keyword{internal} polyCub/man/coerce-sp-methods.Rd0000644000176000001440000000120512236005573016303 0ustar ripleyusers\name{coerce-sp-methods} \alias{coerce,Polygon,Polygons-method} \alias{coerce,Polygon,owin-method} \alias{coerce,Polygons,owin-method} \alias{coerce,SpatialPolygons,owin-method} \alias{coerce-sp-methods} \title{Coerce \code{"Polygons"} to \code{"owin"}} \description{ Package \pkg{polyCub} also implements \code{coerce}-methods (\code{as(object, Class)}) to convert \code{"\link[sp:Polygons-class]{Polygons}"} (or \code{"\link[sp:SpatialPolygons-class]{SpatialPolygons}"} or \code{"\link[sp:Polygon-class]{Polygon}"}) to \code{"\link[spatstat:owin.object]{owin}"}. } \author{ Sebastian Meyer } \keyword{methods} \keyword{spatial} polyCub/man/isClosed.Rd0000644000176000001440000000054712142551047014535 0ustar ripleyusers\name{isClosed} \alias{isClosed} \title{Check if Polygon is Closed} \usage{ isClosed(coords) } \arguments{ \item{coords}{numeric coordinate matrix. It is interpreted by \code{\link{xy.coords}}.} } \value{ logical } \description{ Check if the first and last coordinates of a coordinate matrix are identical. } \keyword{internal} \keyword{spatial}