polyCub/0000755000176200001440000000000013164457775011712 5ustar liggesuserspolyCub/inst/0000755000176200001440000000000013164445703012653 5ustar liggesuserspolyCub/inst/examples/0000755000176200001440000000000013164445703014471 5ustar liggesuserspolyCub/inst/examples/polyCub.iso.R0000644000176200001440000000154313164445703017025 0ustar liggesusers## 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' ## intrfr(R) = int_0^R r*f(r) dr, for f(r) = dexp(r), gives 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(R) = int_0^R r*f(r) dr = int_0^R r dr = R^2/2 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(spatstat::owin(poly = letterR)), area.ISO, check.attributes = FALSE)) ## the hole is subtracted correctly polyCub/inst/examples/polyCub.R0000644000176200001440000000321613163445052016227 0ustar liggesusers### Short comparison of the various 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 octagon <- spatstat::disc(radius = 5, centre = c(3,2), npoly = 8) ## plot image of the function and integration domain plotpolyf(octagon, f, xlim=c(-8,8), ylim=c(-8,8)) ### Two-dimensional midpoint rule testmidpoint <- function (eps, main=paste("2D midpoint rule with eps =",eps)) { plotpolyf(octagon, f, xlim=c(-8,8), ylim=c(-8,8), use.lattice=FALSE) ## add evaluation points to plot with(spatstat::as.mask(octagon, eps=eps), points(expand.grid(xcol, yrow), col=m, pch=20)) polyCub.midpoint(octagon, 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(octagon, f, nGQ=nGQ), digits=16), "\n") } ## 'rotation' affects location of nodes opar <- par(mfrow=c(1,2)) polyCub.SV(octagon, f, nGQ=2, rotation=FALSE, plot=TRUE) polyCub.SV(octagon, f, nGQ=2, rotation=TRUE, plot=TRUE) par(opar) ### Line integration along the boundary for isotropic functions polyCub.iso(octagon, f, center=c(0,0)) # see ?polyCub.iso ### Quasi-exact cubature of the bivariate Gaussian density ### using gpclib::tristrip and mvtnorm::pmvnorm() if (requireNamespace("mvtnorm") && gpclibPermit()) { print(polyCub.exact.Gauss(octagon, mean=c(0,0), Sigma=5^2*diag(2), plot=TRUE), digits=16) } polyCub/inst/examples/plotpolyf.R0000644000176200001440000000134613164435041016642 0ustar liggesusers### a polygonal domain (a rounded version of spatstat.data::letterR$bdry) letterR <- list( list(x = c(3.9, 3.8, 3.7, 3.5, 3.4, 3.5, 3.7, 3.8, 3.8, 3.7, 3.7, 3.5, 3.3, 2, 2, 2.7, 2.7, 2.9, 3, 3.3, 3.9), y = c(0.7, 1.1, 1.3, 1.7, 1.8, 1.9, 2.1, 2.3, 2.5, 2.8, 3, 3.2, 3.3, 3.3, 0.7, 0.7, 1.7, 1.7, 1.5, 0.7, 0.6)), list(x = c(2.6, 2.6, 3, 3.1, 3.2, 3.1, 3.1, 3), y = c(2.2, 2.7, 2.7, 2.6, 2.5, 2.4, 2.3, 2.2)) ) ### 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/CITATION0000644000176200001440000000105612473400656014012 0ustar liggesusers ### Outer header citHeader("To cite", sQuote("polyCub"), "in publications refer to Supplement B (Section 2.4) of:") ### power-law paper bibentry( bibtype = "Article", key = "Meyer+Held_2014", author = "Sebastian Meyer and Leonhard Held", title = "Power-law models for infectious disease spread", journal = "The Annals of Applied Statistics", issn = "1932-6157", year = "2014", volume = "8", number = "3", pages = "1612--1639", doi = "10.1214/14-AOAS743", eprint = "http://arxiv.org/abs/1308.5115" ) polyCub/inst/NEWS.Rd0000644000176200001440000002017413164400262013711 0ustar liggesusers\newcommand{\CRANpkg}{\href{https://CRAN.R-project.org/package=#1}{\pkg{#1}}} %% some pre-defined commands: \R, \code, \acronym, \url, \file, \pkg %% Since R 3.2.0, there are some additional system Rd macros available, %% e.g., \CRANpkg and \doi. See the definitions in the file %% file.path(R.home("share"), "Rd", "macros", "system.Rd") \name{NEWS} \title{News for Package 'polyCub'} \section{Changes in polyCub version 0.6.1 (2017-10-02)}{ \itemize{ \item The exported C-function \code{polyCub_iso()} \dots \itemize{ \item did not handle its \code{stop_on_error} argument correctly (it would always stop on error). \item now detects non-finite \code{intrfr} function values and gives an informative error message (rather than just reporting \dQuote{abnormal termination of integration routine}). } \item Package \pkg{polyCub} no longer strictly depends on package \CRANpkg{spatstat}, which is only required for \code{polyCub.midpoint()}. } } \section{Changes in polyCub version 0.6.0 (2017-05-24)}{ \itemize{ \item Added full C-implementation of \code{polyCub.iso()}, which is exposed as \code{"polyCub_iso"} for use by other \R packages (notably future versions of \CRANpkg{surveillance}) via \samp{LinkingTo: polyCub} and \samp{#include }. \item Accommodate CRAN checks: add missing import from \pkg{graphics}, register native routines and disable symbol search } } \section{Changes in polyCub version 0.5-2 (2015-02-25)}{ \itemize{ \item \code{polyCub.midpoint()} works directly with input polygons of classes \code{"gpc.poly"} and \code{"SpatialPolygons"}, since package \pkg{polyCub} now registers corresponding \code{as.owin}-methods. \item \code{polyCub.exact.Gauss()} did not work if the \code{tristrip} of the transformed input polygon contained degenerate triangles (spotted by Ignacio Quintero). \item Line integration in \code{polyCub.iso()} could break due to division by zero if the \code{center} point was part of the polygon boundary. } } \section{Changes in polyCub version 0.5-1 (2014-10-24)}{ \itemize{ \item Nodes and weights for \code{polyCub.SV()} were only cached up to \code{nGQ=59}, not 60 as announced in version 0.5-0. Fixed that which also makes examples truly run without \pkg{statmod}. \item In \code{polyCub.SV()}, the new special setting \code{f=NULL} means to only compute nodes and weights. \item Internal changes to the \code{"gpc.poly"} converters to accommodate \CRANpkg{spatstat} 1.39-0. } } \section{Changes in polyCub version 0.5-0 (2014-05-07)}{ \itemize{ \item \code{polyCub.SV()} gained an argument \code{engine} to choose among available implementations. The new and faster C-implementation is the default. There should not be any numerical differences in the result of the cubature. \item Package \CRANpkg{statmod} is no longer strictly required (imported). Nodes and weights for Gauss-Legendre quadrature in \code{polyCub.SV()} are now cached in the \pkg{polyCub} package up to \code{nGQ=60}. \pkg{statmod}\code{::gauss.quad} is only queried for a higher number of nodes. } } \section{Changes in polyCub version 0.4-3 (2014-03-14)}{ \itemize{ \item \code{polyCub.iso()} ... \itemize{ \item could not handle additional arguments for \code{integrate()} given in the \code{control} list. \item applies the \code{control} arguments also to the numerical approximation of \code{intrfr}. } \item The \code{checkintrfr()} function is exported and documented. \item Added a \file{CITATION} file. } } \section{Changes in polyCub version 0.4-2 (2014-02-12)}{ \itemize{ \item \code{plotpolyf()} ... \itemize{ \item gained an additional argument \code{print.args}, an optional list of arguments passed to \code{print.trellis()} if \code{use.lattice=TRUE}. \item passed a \emph{data frame} of coordinates to \code{f} instead of a matrix as documented. } } } \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/inst/include/0000755000176200001440000000000013163463332014273 5ustar liggesuserspolyCub/inst/include/polyCubAPI.h0000644000176200001440000000325713163463332016422 0ustar liggesusers/******************************************************************************* * Header file with wrapper functions for the C-routines provided by polyCub * * Copyright (C) 2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ #include // NULL #include // SEXP #include // R_GetCCallable typedef double (*intrfr_fn) (double, double*); void polyCub_iso( double *x, double *y, // vertex coordinates (open) int *L, // number of vertices intrfr_fn intrfr, // F(R) double *pars, // parameters for F(R) double *center_x, double *center_y, // center of isotropy int *subdivisions, double *epsabs, double *epsrel, // Rdqags options int *stop_on_error, // !=0 means to stop at first ier > 0 double *value, double *abserr, int *neval) // results { static void(*fun)(double*,double*,int*,intrfr_fn,double*,double*,double*, int*,double*,double*,int*,double*,double*,int*) = NULL; if (fun == NULL) fun = (void(*)(double*,double*,int*,intrfr_fn,double*,double*,double*, int*,double*,double*,int*,double*,double*,int*)) R_GetCCallable("polyCub", "polyiso"); fun(x, y, L, intrfr, pars, center_x, center_y, subdivisions, epsabs, epsrel, stop_on_error, value, abserr, neval); return; } polyCub/tests/0000755000176200001440000000000013163463332013035 5ustar liggesuserspolyCub/tests/testthat/0000755000176200001440000000000013163463332014675 5ustar liggesuserspolyCub/tests/testthat/polyiso_powerlaw.c0000644000176200001440000000344713163463332020467 0ustar liggesusers/******************************************************************************* * Example of using the C-routine "polyCub_iso", see also test-polyiso.R * * Copyright (C) 2015,2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ #include #include // F(R) example static double intrfr_powerlaw(double R, double *logpars) { double sigma = exp(logpars[0]); double d = exp(logpars[1]); if (d == 1.0) { return R - sigma * log(R/sigma + 1); } else if (d == 2.0) { return log(R/sigma + 1) - R/(R+sigma); } else { return (R*pow(R+sigma,1-d) - (pow(R+sigma,2-d) - pow(sigma,2-d))/(2-d)) / (1-d); } } // function to be called from R void C_polyiso_powerlaw( double *x, double *y, // vertex coordinates (open) int *L, // number of vertices //intrfr_fn intrfr, // F(R) double *pars, // parameters for F(R) double *center_x, double *center_y, // center of isotropy int *subdivisions, double *epsabs, double *epsrel, // Rdqags options int *stop_on_error, // !=0 means to stop at first ier > 0 double *value, double *abserr, int *neval) // results { polyCub_iso(x, y, L, intrfr_powerlaw, pars, center_x, center_y, subdivisions, epsabs, epsrel, stop_on_error, value, abserr, neval); return; } polyCub/tests/testthat/test-NWGL.R0000644000176200001440000000056713111117533016544 0ustar liggesuserscontext("Validation of cached Gauss-Legendre nodes/weights") if (requireNamespace("statmod")) { test_that("statmod::gauss.quad() still gives the same result", { new.NWGL <- lapply(seq_len(61L), function (n) unname(statmod::gauss.quad(n = n, kind = "legendre"))) expect_equal(new.NWGL, .NWGL, check.attributes = FALSE) }) } polyCub/tests/testthat/test-regression.R0000644000176200001440000000110313163445336020154 0ustar liggesuserscontext("Regression tests") octagon <- spatstat::disc(radius = 5, centre = c(3,2), npoly = 8) f <- function (s) (rowSums(s^2)+1)^-2 ##plotpolyf(octagon, f) test_that("isotropic cubature can handle control list for integrate()", { ## previosly, passing control arguments did not work int1 <- polyCub.iso(octagon, f, center=c(0,0), control=list(rel.tol=1e-3)) int2 <- polyCub.iso(octagon, f, center=c(0,0), control=list(rel.tol=1e-8)) ## results are almost but not identical expect_equal(int1, int2, tolerance=1e-3) expect_false(identical(int1, int2)) }) polyCub/tests/testthat/test-polyCub.R0000644000176200001440000000404113111117533017401 0ustar liggesuserscontext("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 intExact <- 0.65844436 if (requireNamespace("mvtnorm") && gpclibPermit()) { ## run this conditionally since gpclib might not be available on all ## platforms (as pointed out by Uwe Ligges, 2014-04-20) test_that("polyCub.exact.Gauss returns validated result", { int <- polyCub.exact.Gauss(disc.owin, mean=m, Sigma=sd^2*diag(2)) expect_equal(int, intExact, tolerance=1e-8, check.attributes=FALSE) }) } ### 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_equal(intExact, 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_equal(int, intExact, tolerance=0.001, check.attributes=FALSE) }) test_that("SV-cubature is correct", { intC <- polyCub.SV(disc.owin, f, mean=m, sd=sd, nGQ=3, engine="C") intR <- polyCub.SV(disc.owin, f, mean=m, sd=sd, nGQ=3, engine="R") expect_equal(intC, intR) expect_equal(intC, 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_equal(int0, intExact, check.attributes=FALSE) }) polyCub/tests/testthat/test-polyiso.R0000644000176200001440000000763513111604463017501 0ustar liggesuserscontext("polyCub_iso C-routine (API)") ## CAVE (as of R-3.4.0 with testthat 1.0.2): ## During R CMD check, tools:::.runPackageTests() sets R_TESTS=startup.Rs, ## a file which is created in the parent directory "tests", see ## file.path(R.home("share"), "R", "tests-startup.R") ## for its contents. However, testthat tests are run with the working directory ## set to here, so auxiliary R sessions initiated here would fail when trying ## to source() the R_TESTS file on startup, see the system Rprofile file ## file.path(R.home("library"), "base", "R", "Rprofile") ## for what happens. Solution: unset R_TESTS (or set to "") for sub-R processes. ## function to call an R CMD with environment variables ## 'env' specified as a named character vector Rcmd <- function (args, env = character(), ...) { stopifnot(is.vector(env, mode = "character"), !is.null(names(env))) if (.Platform$OS.type == "windows") { if (length(env)) { ## the 'env' argument of system2() is not supported on Windows setenv <- function (envs) { old <- Sys.getenv(names(envs), unset = NA, names = TRUE) set <- !is.na(envs) if (any(set)) do.call(Sys.setenv, as.list(envs[set])) if (any(!set)) Sys.unsetenv(names(envs)[!set]) invisible(old) } oldenv <- setenv(env) on.exit(setenv(oldenv)) } system2(command = file.path(R.home("bin"), "Rcmd.exe"), args = args, ...) } else { system2(command = file.path(R.home("bin"), "R"), args = c("CMD", args), env = paste(names(env), env, sep = "="), ...) } } message("compiling polyiso_powerlaw.c using R CMD SHLIB") shlib_error <- Rcmd(args = c("SHLIB", "--clean", "polyiso_powerlaw.c"), env = c("PKG_CPPFLAGS" = paste0("-I", system.file("include", package="polyCub")), "R_TESTS" = "")) if (shlib_error) skip("failed to build the shared object/DLL for the polyCub_iso example") ## load shared object/DLL myDLL <- paste0("polyiso_powerlaw", .Platform$dynlib.ext) loadNamespace("polyCub") dyn.load(myDLL) ## R function calling C_polyiso_powerlaw polyiso_powerlaw <- function (xypoly, logpars, center, subdivisions = 100L, rel.tol = .Machine$double.eps^0.25, abs.tol = rel.tol, stop.on.error = TRUE) { .C("C_polyiso_powerlaw", as.double(xypoly$x), as.double(xypoly$y), as.integer(length(xypoly$x)), as.double(logpars), as.double(center[1L]), as.double(center[2L]), as.integer(subdivisions), as.double(abs.tol), as.double(rel.tol), as.integer(stop.on.error), value = double(1L), abserr = double(1L), neval = integer(1L))[c("value", "abserr", "neval")] } ## example polygon and function parameters set.seed(1) xy <- list(x = stats::rnorm(10), y = stats::rnorm(10)) hidx <- grDevices::chull(xy) xypoly <- lapply(xy, "[", rev(hidx)) # anticlockwise vertex order logpars <- log(c(0.5, 1)) (res <- polyiso_powerlaw(xypoly, logpars, center = c(0,0))) ## compare with R implementation intrfr.powerlaw <- function (R, logpars) { sigma <- exp(logpars[[1L]]) d <- exp(logpars[[2L]]) if (d == 1) { R - sigma * log(R/sigma + 1) } else if (d == 2) { log(R/sigma + 1) - R/(R+sigma) } else { (R*(R+sigma)^(1-d) - ((R+sigma)^(2-d) - sigma^(2-d))/(2-d)) / (1-d) } } (orig <- polyCub:::polyCub1.iso(xypoly, intrfr.powerlaw, logpars, center = c(0,0))) test_that("C and R implementations give equal results", { expect_equal(res$value, orig[1]) expect_equal(res$abserr, orig[2]) }) ## microbenchmark::microbenchmark( ## polyCub:::polyCub1.iso(xypoly, intrfr.powerlaw, logpars, center = c(0,0)), # 250 mus ## polyiso_powerlaw(xypoly, logpars, center = c(0,0)), times = 1000) # 50 mus dyn.unload(myDLL) file.remove(myDLL) polyCub/tests/test-all.R0000644000176200001440000000013613111116012014664 0ustar liggesusersif (require("testthat") && packageVersion("testthat") >= "0.9") { test_check("polyCub") } polyCub/src/0000755000176200001440000000000013164451700012457 5ustar liggesuserspolyCub/src/polyCub.SV.h0000644000176200001440000000160113164451700014572 0ustar liggesusers/******************************************************************************* * Header file of polyCub.SV.c * * Copyright (C) 2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ void C_polygauss( double *x, double *y, // vertex coordinates (open) of a polygon double *s_M, double *w_M, // nodes & weights of Gauss-Legendre quadrature double *s_N, double *w_N, // of degree M=N+1 and N, respectively double *alpha, // base-line int *L, int *M, int *N, // L: number of edges/vertices // result: nodes and weights of length (<=) M*N per edge double *nodes_x, double *nodes_y, double *weights); polyCub/src/polyCub.SV.c0000644000176200001440000000571613164451700014600 0ustar liggesusers/******************************************************************************* * C-version of .polygauss.side() * * Copyright (C) 2014,2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ #include "polyCub.SV.h" static void C_polygauss_side( double *x1, double *y1, double *x2, double *y2, double *s_loc, double *w_loc, double *s_N, double *w_N, double *alpha, int *loc, int *N, // lengths (loc is M=N+1 or N) // *loc * *N nodes and weights will be computed double *nodes_x, double *nodes_y, double *weights) { double half_pt_x = (*x1 + *x2) / 2.0; double half_length_x = (*x2 - *x1) / 2.0; double half_pt_y = (*y1 + *y2) / 2.0; double half_length_y = (*y2 - *y1) / 2.0; double x_gauss_side, y_gauss_side, scaling_fact_minus; int idx; for (int i = 0; i < *loc; i++) { // GAUSSIAN POINTS ON THE SIDE x_gauss_side = half_pt_x + half_length_x * s_loc[i]; y_gauss_side = half_pt_y + half_length_y * s_loc[i]; scaling_fact_minus = (x_gauss_side - *alpha) / 2.0; // COMPUTE NODES AND WEIGHTS for (int j = 0; j < *N; j++) { idx = j * *loc + i; // use same order as in R implementation nodes_x[idx] = *alpha + scaling_fact_minus * (s_N[j] + 1.0); nodes_y[idx] = y_gauss_side; weights[idx] = half_length_y*scaling_fact_minus * w_loc[i] * w_N[j]; } } } /*** * Function to be called from R to loop over all polygon edges, * calling the above C_polygauss_side() for each ***/ void C_polygauss( double *x, double *y, // vertex coordinates (open) of a polygon double *s_M, double *w_M, // nodes & weights of Gauss-Legendre quadrature double *s_N, double *w_N, // of degree M=N+1 and N, respectively double *alpha, // base-line int *L, int *M, int *N, // L: number of edges/vertices // result: nodes and weights of length (<=) M*N per edge double *nodes_x, double *nodes_y, double *weights) { int idxTo, idxBlock; double x1, y1, x2, y2; for (int i = 0; i < *L; i++) { x1 = x[i]; y1 = y[i]; if (i == *L-1) idxTo = 0; else idxTo = i+1; x2 = x[idxTo]; y2 = y[idxTo]; // if edge is on base-line or is orthogonal to it -> skip if ((x1 == *alpha && x2 == *alpha) || (y2 == y1)) continue; idxBlock = i * *M * *N; // start index of nodes of edge i if (x2 == x1) // side is parallel to base-line -> use degree N in both dimensions C_polygauss_side(&x1, &y1, &x2, &y2, s_N, w_N, s_N, w_N, alpha, N, N, nodes_x + idxBlock, nodes_y + idxBlock, weights + idxBlock); else // use degrees M and N, respectively C_polygauss_side(&x1, &y1, &x2, &y2, s_M, w_M, s_N, w_N, alpha, M, N, nodes_x + idxBlock, nodes_y + idxBlock, weights + idxBlock); } } polyCub/src/polyCub.iso.h0000644000176200001440000000176713164451700015051 0ustar liggesusers/******************************************************************************* * Header file of polyCub.iso.c * * Copyright (C) 2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ typedef double (*intrfr_fn) (double, double*); void polyiso( double *x, double *y, // vertex coordinates (open) int *L, // number of vertices intrfr_fn intrfr, // F(R) double *pars, // parameters for F(R) double *center_x, double *center_y, // center of isotropy int *subdivisions, double *epsabs, double *epsrel, // Rdqags options int *stop_on_error, // !=0 means to stop at first ier > 0 double *value, double *abserr, int *neval); // results polyCub/src/polyCub.iso.c0000644000176200001440000001171413164451700015035 0ustar liggesusers/******************************************************************************* * C-version of polyCub1.iso() * * Copyright (C) 2015,2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ /* The corresponding math is derived in Supplement B (Section 2.4) of * Meyer and Held (2014): "Power-law models for infectious disease spread." * The Annals of Applied Statistics, 8(3), 1612-1639. * https://doi.org/10.1214/14-AOAS743SUPPB */ #include // R_FINITE, otherwise math.h would suffice #include // error #include // R_alloc #include // Rprintf #include // Rdqags // header file defines the intrfr_fn type #include "polyCub.iso.h" // integrand for the edge (x0,y0) -> (x1,y1), see Equation 7 static double lineIntegrand( double t, double x0, double y0, double x1, double y1, intrfr_fn intrfr, double *pars) { double num = y1*x0 - x1*y0; // numerator term // point on the edge corresponding to t double px = x0 + t*(x1-x0); double py = y0 + t*(y1-y0); double norm2 = px*px + py*py; // evaluate F(R) = int_0^R r*f(r) dr at R=||(px,py)|| double inti = intrfr(sqrt(norm2), pars); if (!R_FINITE(inti)) error("non-finite intrfr value at R=%f", sqrt(norm2)); return num*inti/norm2; } // set of parameters for line integration (passed via the *ex argument) typedef struct { double x0, y0, x1, y1; intrfr_fn intrfr; double *pars; } Params; // vectorized lineIntegrand for use with Rdqags static void myintegr_fn(double *x, int n, void *ex) { Params *param = (Params *) ex; for(int i = 0; i < n; i++) { x[i] = lineIntegrand(x[i], param->x0, param->y0, param->x1, param->y1, param->intrfr, param->pars); } return; } // calculate line integral for one edge (x0,y0) -> (x1,y1) // using Gauss-Kronrod quadrature via Rdqags as declared in , // implemented in R/src/appl/integrate.c, // and used in R/src/library/stats/src/integrate.c static void polyiso_side( double x0, double y0, double x1, double y1, // 2 vertices intrfr_fn intrfr, double *pars, // F(R) int subdivisions, double *epsabs, double *epsrel, // control double *result, double *abserr, int *neval, int *ier) // results { double num = y1*x0 - x1*y0; // numerator in lineIntegrand // for any point p on the edge if (num == 0.0) { // 'center' is part of this polygon edge *result = 0.0; *abserr = 0.0; //*last = 0; *neval = 0; *ier = 0; return; } // set of parameters for lineIntegrand Params param = {x0, y0, x1, y1, intrfr, pars}; // prepare for Rdqags double lower = 0.0; double upper = 1.0; int lenw = 4 * subdivisions; int last; // unused int *iwork = (int *) R_alloc((size_t) subdivisions, sizeof(int)); double *work = (double *) R_alloc((size_t) lenw, sizeof(double)); Rdqags(myintegr_fn, ¶m, &lower, &upper, epsabs, epsrel, result, abserr, neval, ier, // results &subdivisions, &lenw, &last, iwork, work); return; } // line integration along the edges of a polygon void polyiso( double *x, double *y, // vertex coordinates (open) int *L, // number of vertices intrfr_fn intrfr, // F(R) double *pars, // parameters for F(R) double *center_x, double *center_y, // center of isotropy int *subdivisions, double *epsabs, double *epsrel, // Rdqags options int *stop_on_error, // !=0 means to stop at first ier > 0 double *value, double *abserr, int *neval) // results { // auxiliary variables double resulti, abserri; int nevali, ieri; double x0, y0, x1, y1; int idxTo; // initialize result at 0 (do += for each polygon edge); *value = 0.0; *abserr = 0.0; *neval = 0; for (int i = 0; i < *L; i++) { x0 = x[i] - *center_x; y0 = y[i] - *center_y; idxTo = (i == *L-1) ? 0 : i+1; x1 = x[idxTo] - *center_x; y1 = y[idxTo] - *center_y; polyiso_side(x0, y0, x1, y1, intrfr, pars, *subdivisions, epsabs, epsrel, &resulti, &abserri, &nevali, &ieri); if (ieri > 0) { if (*stop_on_error == 0) { Rprintf("abnormal termination of integration routine (%i)\n", ieri); } else { error("abnormal termination of integration routine (%i)\n", ieri); } } *value += resulti; *abserr += abserri; *neval += nevali; } return; } polyCub/src/init.c0000644000176200001440000000167513164451700013577 0ustar liggesusers/******************************************************************************* * Registering native routines (entry points in compiled code) * * Copyright (C) 2017 Sebastian Meyer * * This file is 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 https://www.R-project.org/Licenses/. ******************************************************************************/ #include // for NULL #include #include "polyCub.SV.h" #include "polyCub.iso.h" static const R_CMethodDef CEntries[] = { {"C_polygauss", (DL_FUNC) &C_polygauss, 13}, {NULL, NULL, 0} }; void R_init_polyCub(DllInfo *dll) { R_registerRoutines(dll, CEntries, NULL, NULL, NULL); R_useDynamicSymbols(dll, FALSE); //R_forceSymbols(dll, TRUE); // would require R >= 3.0.0 R_RegisterCCallable("polyCub", "polyiso", (DL_FUNC) &polyiso); } polyCub/NAMESPACE0000644000176200001440000000206613164400262013110 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(xylist,Polygon) S3method(xylist,Polygons) S3method(xylist,SpatialPolygons) S3method(xylist,default) S3method(xylist,gpc.poly) S3method(xylist,owin) export(.polyCub.iso) export(as.owin.Polygon) export(as.owin.Polygons) export(as.owin.SpatialPolygons) export(as.owin.gpc.poly) export(checkintrfr) 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) importClassesFrom(sp,owin) importFrom(grDevices,extendrange) importFrom(grDevices,gray) importFrom(grDevices,heat.colors) importFrom(grDevices,xy.coords) importFrom(graphics,image) importFrom(graphics,lines) importFrom(graphics,points) importFrom(graphics,polygon) importFrom(stats,cov2cor) importFrom(stats,dist) importFrom(stats,integrate) importFrom(stats,pchisq) importFrom(stats,pnorm) useDynLib(polyCub, .registration = TRUE) polyCub/R/0000755000176200001440000000000013164451365012100 5ustar liggesuserspolyCub/R/polyCub.SV.R0000644000176200001440000003422113163463617014173 0ustar liggesusers################################################################################ ### polyCub.SV: Product Gauss Cubature over Polygonal Domains ### ### Copyright (C) 2009-2014,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' Product Gauss Cubature over Polygonal Domains ##' ##' Product Gauss cubature over polygons as proposed by ##' Sommariva and Vianello (2007). ##' ##' @inheritParams plotpolyf ##' @param f a two-dimensional real function (or \code{NULL} to only compute ##' nodes and weights). ##' As its first argument it must take a coordinate matrix, i.e., a ##' numeric matrix with two columns, and it must return a numeric vector of ##' length the number of coordinates. ##' @param nGQ degree of the one-dimensional Gauss-Legendre quadrature rule ##' (default: 20) as implemented in function \code{\link[statmod]{gauss.quad}} ##' of package \pkg{statmod}. Nodes and weights up to \code{nGQ=60} are cached ##' in \pkg{polyCub}, for larger degrees \pkg{statmod} is required. ##' @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 each polygon is chosen if no \code{rotation} ##' is performed, and otherwise the \eqn{x}-coordinate of the rotated point ##' \code{"P"} (see \code{rotation}). 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. ##' @param engine character string specifying the implementation to use. ##' Up to \pkg{polyCub} version 0.4-3, the two-dimensional nodes and weights ##' were computed by \R functions and these are still available by setting ##' \code{engine = "R"}. ##' The new C-implementation is now the default (\code{engine = "C"}) and ##' requires approximately 30\% less computation time.\cr ##' The special setting \code{engine = "C+reduce"} will discard redundant nodes ##' at (0,0) with zero weight resulting from edges on the base-line ##' \eqn{x = \alpha} or orthogonal to it. ##' This extra cleaning is only worth its cost for computationally intensive ##' functions \code{f} over polygons which really have some edges on the ##' baseline or parallel to the x-axis. Note that the old \R ##' implementation does not have such unset zero nodes and weights. ##' @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}.\cr ##' In the case \code{f = NULL}, only the computed nodes and weights are ##' returned in a list of length the number of polygons of \code{polyregion}, ##' where each component is a list with \code{nodes} (a numeric matrix with ##' two columns), \code{weights} (a numeric vector of length ##' \code{nrow(nodes)}), the rotation \code{angle}, and \code{alpha}. ##' @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 ##' Sommariva, A. and Vianello, M. (2007). ##' Product Gauss cubature over polygons based on Green's integration formula. ##' \emph{BIT Numerical Mathematics}, \bold{47} (2), 441-453. ##' @keywords math spatial ##' @family polyCub-methods ##' @importFrom graphics points ##' @examples # see example(polyCub) ##' @export polyCub.SV <- function (polyregion, f, ..., nGQ = 20, alpha = NULL, rotation = FALSE, engine = "C", plot = FALSE) { polys <- xylist(polyregion) # transform to something like "owin$bdry" # which means anticlockwise vertex order with # first vertex not repeated stopifnot(isScalar(nGQ), nGQ > 0, 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(nGQ) ## DEGREE "M" = N+1 (ORDER GAUSS INTEGRATION) nw_M <- gauss.quad(nGQ + 1) ## Special case f=NULL: compute and return nodes and weights only if (is.null(f)) { return(lapply(X = polys, FUN = polygauss, nw_MN = c(nw_M, nw_N), alpha = alpha, rotation = rotation, engine = engine)) } ## Cubature over every single polygon of the "polys" list f <- match.fun(f) int1 <- function (poly) { nw <- polygauss(poly, c(nw_M, nw_N), alpha, rotation, engine) 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 <- vapply(X=polys, FUN=int1, FUN.VALUE=0, 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]], c(nw_M, nw_N), alpha, rotation, engine) points(nw$nodes, cex=0.6, pch = i) #, col=1+(nw$weights<=0) } } ################### int } ## this wrapper provides a partially memoized version of ## unname(statmod::gauss.quad(n, kind="legendre")) gauss.quad <- function (n) { if (n <= 61) { # results cached in R/sysdata.rda .NWGL[[n]] } else if (requireNamespace("statmod")) { unname(statmod::gauss.quad(n = n, kind = "legendre")) } else { stop("package ", sQuote("statmod"), " is required for nGQ > 60") } } ##' 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)}. ##' @inheritParams polyCub.SV ##' @references ##' Sommariva, A. and Vianello, M. (2007): ##' Product Gauss cubature over polygons based on Green's integration formula. ##' \emph{BIT Numerical Mathematics}, \bold{47} (2), 441-453. ##' @keywords internal ##' @useDynLib polyCub, .registration = TRUE polygauss <- function (xy, nw_MN, alpha = NULL, rotation = FALSE, engine = "C") { ## POLYGON ROTATION xyrot <- if (identical(FALSE, rotation)) { if (is.null(alpha)) { # choose midpoint of x-range xrange <- range(xy[["x"]]) alpha <- (xrange[1L] + xrange[2L]) / 2 } angle <- 0 xy[c("x", "y")] } else { ## convert to coordinate matrix xy <- cbind(xy[["x"]], xy[["y"]], deparse.level=0) ## determine P and Q 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] } xyrot <- xy %*% t(rotmat) # = t(rotmat %*% t(xy)) ## convert back to list list(x = xyrot[,1L,drop=TRUE], y = xyrot[,2L,drop=TRUE]) } ## number of vertices L <- length(xyrot[[1L]]) ## COMPUTE 2D NODES AND WEIGHTS. if (engine == "R") { toIdx <- c(seq.int(2, L), 1L) nwlist <- mapply(.polygauss.side, xyrot[[1L]], xyrot[[2L]], xyrot[[1L]][toIdx], xyrot[[2L]][toIdx], MoreArgs = c(nw_MN, alpha), SIMPLIFY = FALSE, USE.NAMES = FALSE) nodes <- c(lapply(nwlist, "[[", 1L), lapply(nwlist, "[[", 2L), recursive=TRUE) dim(nodes) <- c(length(nodes)/2, 2L) weights <- unlist(lapply(nwlist, "[[", 3L), recursive=FALSE, use.names=FALSE) } else { # use C-implementation ## degrees of cubature and vector template for results M <- length(nw_MN[[1L]]) N <- length(nw_MN[[3L]]) zerovec <- double(L*M*N) ## rock'n'roll nwlist <- .C(C_polygauss, as.double(xyrot[[1L]]), as.double(xyrot[[2L]]), as.double(nw_MN[[1L]]), as.double(nw_MN[[2L]]), as.double(nw_MN[[3L]]), as.double(nw_MN[[4L]]), as.double(alpha), as.integer(L), as.integer(M), as.integer(N), x = zerovec, y = zerovec, w = zerovec)[c("x", "y", "w")] nodes <- cbind(nwlist[[1L]], nwlist[[2L]], deparse.level=0) weights <- nwlist[[3L]] ## remove unset nodes from edges on baseline or orthogonal to it ## (note that the R implementation does not return such redundant nodes) if (engine == "C+reduce" && any(unset <- weights == 0)) { nodes <- nodes[!unset,] weights <- weights[!unset] } } ## 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 = weights, angle = angle, alpha = alpha) } ## The working horse .polygauss.side below is an R translation ## of the original MATLAB implementation by Sommariva and Vianello (2007). .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 } ## NOTE: The above .polygauss.side() function is already efficient R code. ## Passing via C only at this deep level (see below) turned out to be ## slower than staying with R! However, stepping into C already for ## looping over the edges in polygauss() improves the speed. ## ## @useDynLib polyCub C_polygauss_side ## .polygauss.side <- function (x1, y1, x2, y2, s_M, w_M, 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) ## ## parallel2baseline <- x2 == x1 # side is parallel to base-line => degree N ## M <- length(s_M) ## N <- length(s_N) ## loc <- if (parallel2baseline) N else M ## zerovec <- double(loc * N) ## .C(C_polygauss_side, ## as.double(x1), as.double(y1), as.double(x2), as.double(y2), ## as.double(if (parallel2baseline) s_N else s_M), ## as.double(if (parallel2baseline) w_N else w_M), ## as.double(s_N), as.double(w_N), as.double(alpha), ## as.integer(loc), as.integer(N), ## x = zerovec, y = zerovec, w = zerovec)[c("x", "y", "w")] ## } ##' @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.R0000644000176200001440000002525713164451365014444 0ustar liggesusers################################################################################ ### polyCub.iso: Cubature of Isotropic Functions over Polygonal Domains ### ### Copyright (C) 2013-2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ #' 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. #' See Meyer and Held (2014, Supplement B, Section 2.4) for mathematical #' details. #' #' @inheritParams plotpolyf #' @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 missing, \code{intrfr} is approximated numerically using #' \code{\link{integrate}} configured with \code{control}. #' @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. This check requires \code{f} #' to be specified. 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}. #' @param plot logical indicating if an image of the function should be plotted #' together with the polygonal domain, i.e., #' \code{\link{plotpolyf}(polyregion, f, \dots)}. #' @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 #' upper bound 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 mathematical formulation of this efficient integration for radially #' symmetric functions was ascertained with great support by #' Emil Hedevang (2013), Dept. of Mathematics, Aarhus University, Denmark. #' @references #' Hedevang, E. (2013). Personal communication at the Summer School on Topics in #' Space-Time Modeling and Inference (May 2013, Aalborg, Denmark). #' #' Meyer, S. and Held, L. (2014). #' Power-law models for infectious disease spread. #' \emph{The Annals of Applied Statistics}, \bold{8} (3), 1612-1639.\cr #' DOI-Link: \url{https://doi.org/10.1214/14-AOAS743}, #' \href{https://arxiv.org/abs/1308.5115}{arXiv:1308.5115} #' @seealso #' \code{system.file("include", "polyCubAPI.h", package = "polyCub")} #' for a full C-implementation of this cubature method (for a \emph{single} #' polygon). The corresponding C-routine \code{polyCub_iso} can be used by #' other \R packages, notably \pkg{surveillance}, via \samp{LinkingTo: polyCub} #' (in the \file{DESCRIPTION}) and \samp{#include } (in suitable #' \file{/src} files). Note that the \code{intrfr} function must then also be #' supplied as a C-routine. An example can be found in the package tests. #' @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 <- !missing(intrfr) # can't estimate error of double approximation center <- as.vector(center, mode = "numeric") stopifnot(length(center) == 2L, is.finite(center)) ## check 'intrfr' function rs <- if (isTRUE(check.intrfr)) { seq(1, max(abs(unlist(lapply(polys, "[", c("x","y"))))), length.out=20L) } else if (identical(check.intrfr, FALSE)) { numeric(0L) } else { check.intrfr } intrfr <- checkintrfr(intrfr, f, ..., center=center, control=control, rs=rs) ## plot polygon and function image 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) } ##' Check the Integral of \eqn{r f_r(r)} ##' ##' This function is auxiliary to \code{\link{polyCub.iso}}. ##' The (analytical) integral of \eqn{r f_r(r)} from 0 to \eqn{R} is checked ##' against a numeric approximation using \code{\link{integrate}} for various ##' values of the upper bound \eqn{R}. A warning is issued if inconsistencies ##' are found. ##' ##' @inheritParams polyCub.iso ##' @param rs numeric vector of upper bounds for which to check the validity of ##' \code{intrfr}. If it has length 0, no checks are performed. ##' @param tolerance of \code{\link{all.equal.numeric}} when comparing ##' \code{intrfr} results with numerical integration. Defaults to the ##' relative tolerance used for \code{integrate}. ##' @return The \code{intrfr} function. If it was not supplied, its quadrature ##' version using \code{integrate} is returned. ##' @importFrom stats integrate ##' @export checkintrfr <- function (intrfr, f, ..., center, control = list(), rs = numeric(0L), tolerance = control$rel.tol) { doCheck <- length(rs) > 0L if (!missing(f)) { f <- match.fun(f) rfr <- function (r, ...) r * f(cbind(center[1L]+r, center[2L], deparse.level=0L), ...) quadrfr1 <- function (R, ...) integrate(rfr, 0, R, ...)$value if (length(control)) body(quadrfr1)[[2L]] <- as.call(c(as.list(body(quadrfr1)[[2L]]), control)) quadrfr <- function (R, ...) vapply(X = R, FUN = quadrfr1, FUN.VALUE = 0, ..., USE.NAMES = FALSE) if (missing(intrfr)) { return(quadrfr) } else if (doCheck) { cat("Checking 'intrfr' against a numeric approximation ... ") stopifnot(is.vector(rs, mode="numeric")) if (is.null(tolerance)) tolerance <- eval(formals(integrate)$rel.tol) ana <- intrfr(rs, ...) num <- quadrfr(rs, ...) if (!isTRUE(comp <- all.equal(num, ana, tolerance=tolerance))) { cat("\n->", comp, "\n") warning("'intrfr' might be incorrect: ", comp) } else cat("OK\n") } } else if (doCheck) { stop("numerical verification of 'intrfr' requires 'f'") } match.fun(intrfr) } ##' \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 upper bound 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) { res <- sum(vapply(X=ints, FUN="[", FUN.VALUE=0, 1L, USE.NAMES=FALSE)) attr(res, "abs.error") <- sum(vapply(X=ints, FUN="[", FUN.VALUE=0, 2L, USE.NAMES=FALSE)) res } else { sum(unlist(ints, recursive=FALSE, use.names=FALSE)) } } ## cubature method for a single polygon polyCub1.iso <- function (poly, intrfr, ..., center, control = list(), .witherror = TRUE) { xy <- cbind(poly[["x"]], poly[["y"]], deparse.level=0L) nedges <- nrow(xy) intedges <- erredges <- numeric(nedges) for (i in seq_len(nedges)) { v0 <- xy[i, ] - center v1 <- xy[if (i==nedges) 1L else i+1L, ] - 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") ## } if (.witherror) { c(int, sum(erredges)) } else { int } } ## line integral for one edge ##' @importFrom stats integrate lineInt <- function (v0, v1, intrfr, ..., control = list()) { d <- v1 - v0 num <- v1[2L]*v0[1L] - v1[1L]*v0[2L] # = d[2]*p[,1] - d[1]*p[,2] # for any point p on the edge if (num == 0) { # i.e., if 'center' is part of this polygon edge return(list(value = 0, abs.error = 0)) } integrand <- function (t) { ## get the points on the edge corresponding to t p <- cbind(v0[1L] + t*d[1L], v0[2L] + t*d[2L], deparse.level=0L) norm2 <- .rowSums(p^2, length(t), 2L) 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)) } 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 = list()) { 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)) } polyCub/R/polyCub.R0000644000176200001440000000446713163463617013655 0ustar liggesusers################################################################################ ### polyCub: Wrapper Function for the Various Cubature Methods ### ### Copyright (C) 2009-2013 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ #' 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/sysdata.rda0000644000176200001440000004464412375637762014266 0ustar liggesusersý7zXZi"Þ6!ÏXÌà|¨Ih])TW"änRÊŸ’Ù¢Ä)'dzø$&}ïT©¶1}»¥ýá}£ IæÿºL9d]èžðhÏf½¬ ‚†QcåŒÝv\ ïDƒºÃ¿ÞNÖ€¢þG‡sF¥cw½}ì8ð=ôëíɪ±É¥""ûšìÔ(ÍUœ½©=©ñò ÿ® b4ÚÊ Yq®:>µq®´÷xèãÛ6¤J6LæUB4ù€œ°°Üx}0‹&ˆ[à§g»"Q­øCBžb9±„‘†,òä€Êîxg†˜™îª•eÞ‹Œ®|`†$ÚÙ”˜'«Nâz#÷°÷3< @ç‰?Õ4ò¬±kàŸ×Öw‚’,aÄsk¢‚ËfG ¶â8y×m[¨'Zl™DÚr¾KäGµîÅ3ïôúC“,„ÎACIŠ€³í“Â[ :Qms‚Ä]ë³¾+) éÛ1ER˹•»¬FŠˆö´bžžK%ˆua±êR4ûf!5P)~+LbùóBFøÐ{Oqì@míH£M´‡¤ŽƒNà+`Òë]±˜r¨WI—›¿±à5O.SÞŸ\BlºO!É«B|ôUK-ï…©à½ésk¹‹<á`p[_Fм’ºÑäƒ'vÃ`¬ã#È®d¡û3ê®Dí}ÀÎÃhmäŸ _Ëý¼ì§0ø4zŠYe€†WÍg—UÑðƒ „©-}¹_ϬHìõ×Î>à†Œ4®dó•Óbn™*Îý &!d0ôLÎ!dÉÒ†;¾b.jH¦)˜\¨Í9м ©A¿Ja´û¸”_þFÿÛ>úä=–{iª*[B$85óÂÍ‹¡Íž;ÞfÒyùœ+ Ì!+ÔÏ·ŸW•6ßþgí_À­ \M’µŽj'ã0c™“… Û2‚ý¾(ÕÌ®jï÷Eˆ'Žd ,mäã ó§´ÀÊ“(ÑeëmÐgW| ß’A6VÊ°²Š©B«±`†ÄÐöM91·— iOYâ -ÒHä/Åž3±ïµÔDíº¯Ö ,Õ6P«K­¶Z·r«áN02Ÿp Òj“õ„…Ó¢‚Oo†ºŸ¹ C]½Á )À˧.-h[Öc6GÂÇçŽ÷_§¾žÚ¢ZŒdvy ðÓLËœž÷Ù‡)"$m…ˆ¨luÔuÛè誣µ„Hå%©²ù÷6ƒBßC7ÒIç®xJ»îbûò4(KÂ\Ï`Ìî«34¦3åÛu*·Ò¡>êL”ׇ.In’ô¡m°ë0†•j Ž)£/\†”J)§œr6wjüÀÓ³„QWî1±·M>ÎÀä}Ð(B¨’‰ýYåðÃÝÿ™Å¼õ{ŽÜs)q¬ »MþÓyó ›±pUþA<ŠoRY±öè–¦õÆuM^qÆUP¹ˆËÞ ï¡6­²Ï“©®ÂÉe”‹Æc°á¸oÙ¸cð}“§î H–çÀ`-Cëç¤~õ2ºu”šƒãiÊßÉY†Ôl¦¾9óá8›ô“‰ópóïO’¾hÇF¥éõ­”ô>v…ùÂs‰U¹ßÕüj0¨Ëh1qŒÐdÝ)¼ºô,³åÂC¿\-ÕÂv`7Þ[1á}‹°%l7Ý‚¬¹(&{d¯ù¢ ña¨~þtÂÆð¤ÇÔÓ0Å–y¯f¿é¢ôk_lJ:ì0……JMÚ^â¨g X+.Ç2»{”ƒ¢Z¦ÅîFçáÏG_Öe·5x+}OY5k£¥Ð¹-J‡º°Fëoâ‘5_Q ý:!úòIÝ^oO}µeÅ%oGé€8xÞýôO*¶æÃ÷Ý¿©ï <Ò^LþÕÙðx†à8‹ào}áûõÅõ~;u/T–æ%6ÂAej¢BB¾°« ‹R63*7ýì(õæ–ÑQ’ãÙöL#iÞî›ZLƒÔ¤‰ªŠµ?„GÆoïkîÄL‹à­hÛÚÛ»å­.Á0ìö€†¡ûò =Ý--[A §½aÝÏ—/¿íx\–—㇑&$qÔ+šp!Óì6’½e=œjµ;›+£^ŸN÷qÄÇ=‡€v¸ëÜ%Ö"tJÄÂð$2½/:Ȳâ†3EƒBöJÊ@rŘïH§KóEGké“Ú‚œ„2tÂ=,ŒNe×s!2¤M³ùXOæ÷9ïÔ²Ö³ÀÐoD‰aU~7¤©q¤Ã”9¸ŽyÊën/ðot×'çÏ 7oYz™\‹£2§´z䘯 Pý+r” « ñ‚f¦0‡ÓpQ-¯µhG̨•LÜ—þo.Š›wÓ'Î/ªmG½Ð˜±¡‰ ÒÓAh‚ü9fŽÎØݳ(+xaF-[ËñÃGÄ5Æ¡O1\´6ÇœD—ëDªâ\d‘dÛ·bqƒÃK½1ŽG¼Ù„ªqépÐ’ÃjæŸÕ‚bÕö¾ ™;Óö©Ç‘l¿ÄnlP·¸‹ù!‚õ\á6G’s•©Æéi â­AQcxl‹ 4ÍÅu²gêÃBþ`$ó ÅL 5Á€»€Ô  åp¶3ÉK½ù8c†,‹4ÙH”Ä3‚ï5Ü°ÏJÛt.ÿV Cꈥ¹x‘Ù-ÛÁj¼uÃâçv´.ŽNûc»J üÕøÑW2 /¯òˆ}ݽÓÙx¥W³ï)¡qúÞS<§f;ç8¹©ÉØ¿‚ª,® UÛ2‚Pt/¿F·ú}'”懂 Ç?GÂCÿ,˜Ó馸â›tÒUÉøžÁñ|PZ(3Š6Ø{s@e> _ÚÙ­5ßÒ÷Ý-*W‡¿‚ÛX†:l|PÅÂ…þ¥df9‚Ö€u Hs s¾>¾‹°àkï•»ìÿÇ´ùô­Œ-‚ïZ™žZ#všnz\ÀÉ3'ç̾`ÒAzÍ]ÊrwÃ?º ô$¡œ„£œ½Y’2Ój^Ü©¥ÌìüÁQ@xr68”‡éR=ÔÝrÿ!r1êYmW©S<¶Ñ%c ƒ€Hjòúɺú˜{ÕÂilÍL6Æî~Ò¨Ã/•~ñ™ÞežÚ•êrhÏBA¶ vJV¬/Çq5cær´ó`Â*Zý庅PJ8ÏZÍÚ²¶ì°­ÈƒD7Ë”“„?OΟã7aìý1›clfÑî³å’¦n£*_R— ½U\ÃK¶¯SàµiNB¾:ÈfO®ý{¶!BôÂ3ì 59¶Ø2#9-ØÈ„°=jC7m^R3ÿÞ%€u [U/|ih R~§°xK’@|ëÐÂÌ[•¼!Þí¶XdéÂþ~:"…O÷æÇáEùmº¾ÓpE«º·»ÖÙ߃Ԋ§s2Óº€ K¹6èOÉÅ® ).å.k{W’CbÂG] ȸü¶>¦¢Žq4PÇsn&vÍãE¦<|E­ŸÎ„1|šibBËRº;U}h».ÉèvY^ª£ø pmžZ¤óõ’À_÷ÞÈÁ0‘nÿAÈYŸÊx³ólBW¬›Ê6*÷ñZPãÕ Èô]gV°>æÓɉ¢©f_ Çl/ÒhOÙy¶Ë”d“Óà—éÃ[ŒÐ¡YL¤¤Eè'aú±Þ]$À,Áˆo„Š[Æ°ÕšuuíVHF(ŠXÅfHÅ'q~£pfê>þõðð9¼ŠÁk¾Ñ7Þ”3ÝÑð¤`èA(²hÁÖûzsí*n‰Ô°¸ÆÌéÊ-jÖyÄx–¿ÐÄ›³Ñ¥ñ€ˆŒ—$ ¥’ÑÒ×*£lÀÖ'èEXTm¡EÊ%ÛŸc¹cÐ[ÒÜîÜ0J}=§» 4ÜAT†+:öoð¹Ðñju±˜-̃Ûb[e>šœQøªƒª¹ýa¦ÁÓóÙí²‘áD0ê*í‘â ¨öúHÓð óP󆑕3ÿ”w"C 57‰;úFd˜|k4UÃ/-øÖÿI8aEçýw»]EIÝ÷>ôÀ0“ÚÓ²f¯ì,Kw:}!!…†Ï|d9=·“›àÁˆÑ‡ÿ1º u*1YWõȘ  ‰±Y©rÑT¼#õ“¡ÏâïÖÀ#‡€?€Þÿ>êFìVTÌÃ1[_¥æÝR¡zž·‰2a!Wìó2NyýH±;®è bƒÐb~Ó„dʲ 6B }Ìô÷ôN4ý:/ 7zïEWŠ3W²¶¶èn9•e¨eƒãÎÞ²£ ն*9Õ:ï‹Ú½coLµò64ã/³+Fp¬Îqòyær³ Ï:—ŒŸ­À9`ÍšÊÕÅ­øUüÔ~²d;¹%6] 2­kMexöHõÎp'ËÌ0·°róïW6“dEká”#^Þa+§¤)Àè cìÕÑ‘9úÏJ¤­-çI`4¬[LË]t£¢7Ä·Ò§2 0–#kˆ1ª?þ»L}älÈÃòà*Q2[ˆÝû-ʹ,;¨•–•œ#ÆÂRÚXÉÊ1$dá–©€C àcêåÕ¡”‰‚:ÆñNعX÷Ñ (錼;»âG1¤5 `%X´OJV%?ïÓEk†:¹­÷u­y#ÆŽ]}Îôþ-`)“w¢\‰ ÊM©½gEd¤X’•ðÐ+ndY —‰¯^LÎ)“Hí§Qákœ {+‘ö—QØÄꦋ,(³§áµØ¶ü4¥h'|ÞDÏÞ ò_`mcPêφ•Î¶6Uš´Ó³âƼ=þ«Ô®êmî";N û`¿CíA•…h©‚`á(JØýq-±¾²ÊI¸Ä8ξq4( —ó¤`BH/ë…h[r#§h©÷vÁp³œ7“‰?%^q¥|Ó"¾JU6jå6æ[OG=Œ§*ß&‚õÁðÍ'pú‰Î8aè¤Ë.ü§¦ ª;½ 6s‰º_–üEÑ®†D?ùZëõù=Çm2Õ‚Á:ö´8fƒ†gõÉŒxˡ]ß÷ßÿêS&³¬W¥ÙC¹öZq"àÄWÉ–¥ú5£©¶­_Š|Á”|Ððª.©ÙŒ%þœ5÷9ø2•ú3ºGCQ†¿Dä-Kà ÚI<¡fŽˆ”àZ‡x ecÔo¼É7Ú²öqH’ ñVCÙ¹SÇè$^"'êëw 4ç¦Ñ펴nN©G]yEès´—u°—ɦÛ@[½Îã#t„é"VÝhînCdeå$èl€ë»ö˜%“I¿Vï$ÓqirW|ºÁ¶¶)@QAç•–x—Ù$Z µãK —ÕCÃÏ´}šÇô†ý™î>J Š¥Ö#¬2õ]d³ÁMç7[Ü*’A?&îÌáßeÆn6âÝqY}dBPáiz48Vò|Í)k™ä`ÄOFo·TîñÀé‹W)¸íh{F³nø”Ø$ÈëèÓ‚';í¥ñD•šÕ÷aìÚ‚Ë1K²{™¢ŽùâØ¥>Öæÿ ¥…°1¤Q«‚wrHÿ" !gb=œ±jšÄ-›«"‰®x­F=¥6%ÛûQ˜g©jñ›d'„ÉwÜü†fî_1@—bZlm*Í^Ëa´#ÇíHf×í“"‰6Ç­‹Ë+ÃǹhëõücÈ}|¬ “xž2‚®Ì#r~ÏV,¼ ¬^ûM@Á¡ŽÇüý–ó©tl³yY×á<[¿<ÿ(gVáÒèÚñ󋇅@¿ÍÐ %µúˆÉ>ðl–:ÛèÌ+8’iEàÆ&µ6“µ{Ðv()#QÇü²(œ’’YyÜݹæ]—¸–ž,øÔ>Ãk„v.ÒA2Må'ýÒJÖTZØ6îRÃfaèN×îð%8i%Leÿ–z¦8ñé1‡à\*ôZ‘ê©ÒÅy‰xó[ùŒNé;²¶Â É+ÑÔ G²E¤”‚fÓüt_º9M"ù^[Rˆè`™‰¸J_1¼õ<ÕZ,5ÆPòÔ—þpSÔQ”™ZöJ/(+½÷ð¤¬Îeü|M5Ø/ïd lf£YýsÁZžzŸ„9ñ¯ð/êóºŒ>áA(àSë­’ûô ÄÚÆ}¸Of*w¥H_…›(Ëð`¡¿“‘bcF¸°ãUN¹›ŽMò¨ñÑUAeÚ¯f AÑž Ù|m_è1sŒÚ ~´… ‰Ÿ¹ Ž“¢[‰dóÅ÷©iw¡‹b’ý°ˆ¥ZËš¿µçŸwEeÜ9³ñËHbí1Y&Á‚É‚Š ÎýÛ7x"†Í\çD9Ξ¢KáztE±ÿ쌛äõxü…q>ËŽ&ÓÙR^áD¬¤$ÞlfëO~€zsÏ9P[ãÕ¨ˆ2Êñ'NÙýR­©x OºªçîµÌÄ=±F Âò(ûühŸ¶òu ¤|Ï'æ{Ú—€Âß›ô6P2Dÿ™hº‡bˆ+[ _W™}rátyl”3&38—~;Á°âNú× yQ§ÒèÃØåÖƒ-†ÈäFâÚc#JÓ5ŸáÀeñ ÷b¶d¶„Pƒ/¥ô©¶¯gÇ‚r@²÷•ÏŸ¤®£½rÞʛёÿÁf¯0¤ö™CUº[¡áöu¤g SL»V°Nµep²Zº|JT.Šœ™&›Qmu \Ï'³tÑûZƒ-écC Ó[FU5Ëb» 7¤f"¶Ãöw—J¥–óÊÆ|ÏŠŸ<öô¿NÚ×ö~åU†Ù5<úH‘?²ÕKhW©£{j³åOfª&³çÔEo‹aþâèš,zu/òä“…vœbm붌õoK™¹!wë¥|(ŠÓ¹Ë‰.UÊ‚Àw½'¼×í§u‡Îµ.&è÷hÿS7·%“ÃÿØÈ/ Ávø0Æ«US×z`¾s6oS@Û£ÕÈÒx}Ôu¢ì ÿú{ØûË?×òœp [ǽÇ0$«çŒ^j;¯!œjeZu¤wŽgå[„´²€#ÄÔ?Ú {ÐÈ;J"†R² °X¹±6;« ìX΃6Iˆìœ%­*ñÛcÙª&i2¹€Ð*m7ræ¡2š%»˜lmÈ ¸!#(‹!„Yù¬º·¢l/rÒàN4ç+†ÙNZá_dÒ[:§±Š›â~õüñ"¢á4PNÇWÜþÀ4®‰Ü75 Å©1RGGQJ›‰­¿GFW…¯¤}æuëƒK†~ € ©òê~¦ù`¦Èð¡ã´Rúü›|Ϻ–iIX—D@h1«HßýDZçbÚò=gêA‘Ñ¢O"A\N¾¯š[(¾¡³xfÿ>WJ†®Xu¥8…ŠïSItS˼¤A~1Šàæ«ïcr‚g˜JúÞÀ½'‹Ìë̱´®¹Q@Õ—Á0ÝKj{œ¬dGÌÁ×Y´T0>ýoÊÓâ‹¢jLÈèÝ!¹£Íd*\¤c©·èM 8án‡±aù•­üŒ …<û‚˜Ì^ )بƒh¡¾&ß·×)†%Q·Vu÷$›•%‚ˆcŒ™ê4˜2²êMÚC­BÊQãÅ|ŒÔT<,eSÿû„æ׬uö|îÖK€~•£Ì;5kô»ÕDCìóÅúê-T9G=$?üTÓÛš¡ÅõìHQ‘S%ð§ÍùÉ$Âë…Å ªwLq¡*€•ñBp'W.>Ù34~ä#9üqĹâÈlÛZ èŒXÿSjØ–-Ô.VP33 QQ„2+QÞCÂ,å•Û’§Oæ‘G$)ÔþY&ÞŠ#bónPÝšmŒC <%¬§q BÖÖc.šÈSÒ–[ëÒQôF-k;÷›~OÍæ{8íN“9&»Yìø«¹Ç½¦5¡S–‚qS"Ì-½[¤gQyˆ¾K ±À¯ ª )s2VðYžVÓÉv»=Küè¡øØÔNÃùΡ{Ju ’Õy9¡ÆD,[õ²×ºY‚Y†îàx“ZØ“±V©ðˆÈ«.õNŠ¨Ž´Ž{8ªê22ÉXyýeÐ zà4œË}½Ñp7Q¤˜ ü‚CzøÖÚU™Ç~&¢ý«lNuÇ“a@4÷zûP·ÅÔŠMû¼—êñ‘³U÷ÏvÎWij-؆O_¢2¯šî·…+Úw§ªh–´éÿš€•FÀ)ùðNîìMôçë?öø7쪖³±o›Áãá© p;{xñ“i<‹š?cðÙ<þD‰kôƒ1”ÓTS5ÑÌz[Ga ˆ”Ì ¨t(‰Ä9ÿ†jœà–«“ÎIÖBØ`Äï@aÄöŽÒ¢î*i5}¯“4§N|¦6àp‘üÝŸDjßu n ÉtT²[Å„¢a‡‡ŽÅb[w¨wE$ÿZ×0äBhÔö§3”X@2ób r&ÆûÒÂe-oªK „E î³Ïê![§½^sì¶Ha˜³ GoèKX˜Ò&³/‚WâŒË”ãZâ/6tŇþЙ…Q}‘Õ^Æ©\ƒ‘\ÍŒNK½Ï xaÏ’‰ÑÇ¶Þ „­¤ËoˆKšz뀳 "àèMTè{Ï6ð,;ÙJ«ñd¬\Õjôˆ~¼ñzzÚÉ%à™e̪.™ˆ¶QN‰Ó=¦Ì­byRQQ­É}1E*þ ŦÞjdú°z›f}âéL®Ìñ'›K Ã-¸ÍÿÖ7ĤøeÜÂÊ`£óŸ.¾|G5ßêŽ6²Ý·yUOÝpEpÁ ãF)Ñu'©,6q›`” ¼M÷7¯‹AmFpMË‘a½Ö’Q0«ß8ÊæÁ;:8ОØK„ ñкåI­y1¹8iȼpS6Ðb~0ØdÌ{z†ÿD¨”µä˜mn4åL&öì18´ŽÇÿÐ)ËŽ Hàj_¦ê»ú%D¥—ç¦6OápáÓMwºõÃéÖ6Uïþ€YÓeúuŒ<~­ð ÙÐÜ"x&¿~*P\Ÿ¯ ¦Ÿô'¦FÌj{5 } ~EŽFŒë/×4ÑŠÒèQÓP) !`Ÿ‚ýZ%´<¥7Çìë¦÷î߬©Kþ U÷¸$xË’pPš+ ­ÙÎ3óï)Ìú³xÚ’Å ­‰ÓÐ}q#1b"|<§ð­s¨àDÜO‰Hµ|—S{>©CÃN,Æ•vžóðM‚’P¿ c¾!ÕMxp¿*^D_Î^*¨þÄ\0vØ%¹¿S5N'äœ{G„|8œ‚sÕ£¯‚Z ðw3ø'.·*kx½[0Ï×ú©ˆäìµ… þC€a‘‡¬µ(]M•¿¥¨±¼²€øïì¾Ú¢@‡Õ—>)*ÉD›ez礩´iüzh-™öÜïð xP*¿Šø+qÊ‚â3´ÈC-f…ßKNœôÕ*Ùë·ÈDšnzЗ§XŠ{Â¥Y•3åb{?PLcp³²¢sÊ!<+2£¦j|Þ}»`Ômª—ÞZÞ=ÙѪ±›eÝ#eÉ[Üë«å¹w¥dJq#¡ 7Æ´ÙëFLˆLÃ4Õ™´è³—»h˜ræHY$ Â)IR„çÿ×â×l?lOÂ×ÎýW¬ë•FwBc+L1ü(§ÿ‘±¤í¯’˜˜tü9š-è¼eúD:6€˜J*[ÌÑ /oÅ{é÷!–n÷›;»/vEXcÿÒ8XEÕTU¨#a¿¢y»C«Ó ÃÞDöxF*Ü,R‹ê’¸¼êæ3Ø¿M¤ÄÜñ1¿e€‹¿LN‰“rjYíæ—êR@miì­¢ÎSÌMMîf× /h`«Ò¹Øc>Ãi)~urãæ³ÅÑÑ=Ÿ¸#ùbÁåÀ¢_bš .¦q_gK ÇŸ ‡µŸÎúîØ¿™!ÝpöúHC#*‚n gÞli-Dæ™±:~šƒx“‡¦‹ywŠj‹Ñ˜q¥Ó{ñ¨ø·û ÚBTœÿ¢ƒzùd×v3ÇW ¥TºˆgNËzn|‘ATãW =K_WƒáUš­EÈà;õE5V 3éØÊÊË“á‘Äø»c $Á˜pmëÇNb £Š’Ò Ä؇Ûǘ#(:tyy…ðb! z¸âgõIÃLlâŸC1ù¶ARG<­Ù=Íú6a GkúD ±ÿ & €aA»­Äü"SwŸø^)з÷‡Á:YsC.Û ô:©³!L¢œqOòøóÀ‡Œ¾i—³1› f¥ìǬGÛŸÕØE(7'¼Çk^×YíÜ`éXÓ=D-ã„këHXl³»§.†ÿºãª™Â¤?°ìzY~½-<äĵ’+Õz³ˆL+.iH´FÎO6¢Ç˦ÎD¤!µ$ e/Ö +sÁ~‹ÍÑ4»†ú½#AIÿÇZX8[1õ?ËÅ>Œnô˜²#>8J¶ñE}cÚ³˜Ïí¥%˜­1évf˜Tl…C¨6nʽkmÓ•D$Œðh1°ýËš9MXÉôìyÈÒñ;1 ¸tn£sIÏa ãlWÑŸôW°Ê ‡\ƒ×LÆ ƒ¢œÐXiÅè.B«‰y² ½Ùs—H¿·´üó®­—ý–«ùuê]M|ÁsØf×Ù }þÿQ‚é\Õï÷÷[ý¦¥‰ ˆ] ¢q‹osl?‰h!)+¶ùöÕ#ͬÑ|IõÕ¿Û€R“Ó¯lô‹—¥58Iù&I’ÌMO5=Ÿ~Dˆ¯®©ÛOlòÛ2TÒ|•1™ÓQ¦³RjoÚ/³Û.‚}óÞÉÊ1ö dŠ¿°~c銧»Û«O¯aõ{Á’íÓjÄÿb»½ã•ôBMi¬4K—<î$^.Ðqp@DŠžiŒ”:ú"gt*­:‹'ÔTÄ‹®ìÖ¼ª¦eÅüuòòñófÅ¡FEb׳ˆøœàÝeteí„ÿÐV°§%ML(̸kY¸ÿƒ£^¿’¤oÖÆ’yO„¢›G*$wùç¼k“•We3tã*ÂmV“ˆá!XL%f…´ˆóãznš3s,æõ÷FÁ«3J¹xA§V¯˜0Nâ!{¢²ª{ϧÞ&5"Ž‘ˆXkª®iUš™ªÙœ œ(•¹ä„”C‹pÏå•‘@sukð›æ÷ÔâF‚ŽïÝŽp¡Å¢•‚dÀ(ñ€‘ sENfŸfI3/”­Ý…¹¼WGÐ{8} ÔjÈÕÙtz ôlGM]`!ë ´Tå–/Ä毌@(éËl²ôÂê¤ Ì…>d`[Åq&YæW6/§™p„9j)naQ!â|©ŠýªŠ jw•Àûн\Á,4 ˆ±‘¾jÔ=Gñ;sÆå2ŸÇ‰Ri¾÷ÐØ_yÛ@Ààü<Þ,ŽjÓé›(Ú`¨¼BaÊ:`<,¤ùváWpI‘_“p…•P5a†ƒq7ØZšâ<Ÿ2=‹œ¼IžÒ¨E\e-CLz°‘h«÷š­Â„—/9¢Rz†‘{ U—œ: cnZ0!¤H ·¼¶Š«ËmW>Ç#‰Q;_Ü÷'Afi^Nø¤˜>ºJàäÞ¡XÈŠ<ŠÀc€·ŠZ½‹¯ÈÚ†Yº¹õT8±âú²4?d~¢9áWOe“¨˜Öpô‘À–q_PìԢЈY„΂ôãTÉ ïÏiÃû›«~Î*¢'^ß`fØG­Û¸ôJ´˜ÎΕ·¼¯Þ‘Šõ¦¼êÕ“’!ÂU•œ»Q«¿ôK(‡â¦V¯µ•ù"qªÿ@«Õš˜‘Î`iH8´epñ9Ü- Æi¯”™0y¿â•ê’#ØQüuNÐJN—ãÌäý><×<ÝZ†ryt·)€æÑŽŒÆAÞoð0Ίáöepå|`çë@á©í\Ó0œ,%ɳžÚ­‚UäàHšÀ ñkǹL-IŹo@@¨éÙ…Qºï•›Í’×°× bûfo&Ê™Ã@(ÔVà¯åc´¥êt¿äj“[dja{ŠâDáù®…AX™7ŠêÕ }¨,r8¶:Êü…ÉZ§Yûè`Wgñ4Í•uÁq©í¯ÝüO0ÜçzÕ¡­ù\û¥é ND¼$êŠÿOjZlÌöøLªë¸ÃO'<88->V¬Ùk†Ag§‚Âã¸$"¯áåFsž@]Vç?ùœœ-Adzç„FK«h|îÀ|*, O©Õø0ºËñŠ.T á_n„`m¿H<²á’#¶Ü?É€¦¹SsTg±?¯­NÑËSÐg/– Eÿ¹XLE´©¤ïŸ{vã‘ÉÒÚ,(}þïÀg¬pè=‚ µQÍÅR¶—×È&ÞË ðk«¢Žõ MW#y\ÓŠebÞãÁq&$Nx¬] ɼB“qõºt û€µ¢xd3Ë6ë·ú`µP¾ûl@³w~3‹72R] Ð\ãtoÛo×¥ $^ÚAró:H‰ªK ÿ]sëØ€‘µ½D˜U)¬êÏ07+›šô=Í¡œ‰­ó]=Õ¤”z×Ì©¿6íh+8ö¨z¯j¯;ÿžC¹@¼°4NÂÚ ä¨z`4¼(Ó ð›Ñæ):PW)ÿŽad?ÎñaóøºYoyEåbµ7Ÿù¶¦§XIî e”FŽ"–ª_9¡iÓân1’õãé\P–WÔD,õáÓîcÿ‰`SÊpqW“׉³µ/Vµ „Sº(Å­¥îI8KÕ€˜’Ñ•Ú.áKf¬m_–îo¢“Ø·£ºr×’Ù—Ç#7¶ã¡ ~¶#'Å{ Ÿâ×!^„> •¥tb³ßi;êÀ0!1¥~/§ 6ÊñZÏÛ(ÚC»DËïZïz[2 –b±R€î¯ÑdOãI W‚ÏOÒìŸIÜ*07M8Fas[ùʘ¯¦6"&E)ÙÃFÀ²·‹æ(¨Äˆ-Æt(ËbO¤ñ¹R©ڮˢ¯<¦× ˱¦G÷Ux!Ìm}Zœtv|®å—%ÎRˆXc;È¢»A\!è…çòÚŒ_ýZ`p÷]͇ѠFøKzNµ—y½’±}–ÜvïîòÁ¡žMs{:Ñ1<~‰ôûUcT9ŠWoáo5geL³Ò®L¯§@cçTúõAvãAˆN,s–át Ä°‚™ ù®üvìMµ,ÊÅL×ڹń)ÓŽ[ŸkŽØDÞí°òhÌ0«oÕó:‡ ¦Î wdr‡fÖ3ûqh°·ÛmpàMxDmþ¾%W¼½ížÉ¡¶(ÙÌe>œ÷ø,³¦üñ!#bTáxVÙ²»6F[£v³€oìÛÌÜõ|´Æ`‹Œÿ3¸GfÄ'¦ Á矵-ñÙ^…LsYv“í¯IcNH 2ËрοùW¬{%ê‚ÿf¤ëù¨5U¿¹=Ñ3ïß0O?ÎR‚u‚Ë“e‡<'“æ'ëZ¿[ä0²7®Òp©ÅÁ¥?%wr Oã=Ž!ÏwçLAÛu ¯mÂçÒ•&„̓^%Ù¨{°ß·OjKìP oS[ÒÝ.¿¹mзÖ~wücLgó|ñ5S¡\D¯Ü‘$bó¬$áÈvì5Òó_;ï[ÿEpfE¸g•NÇzä0·õ>+uä°`½±Š¯Ç‰¶?ú®:à³JÚæ½*D¶Ìèàˆ/k Þçáy–?œˆ+ÛÖõ…}ìøyV*<5ƒ¢V_ ½›yƒððï´ÃÅ:-që|SL_*6êMȱK¡ä¯îúëÀE¨KXFÒ†®SÀÛí¬ÄH"( ÊQÿ= òEë*ËQ'?Ä}môÑ&mAçD}©ó:sÿQ_//2¢¥jÜëèž*plÞ¼¦d(®}ëp‹žrµ¼“ÏL5O˜õ®,8ÌÄwQ»±õbÒòmÏõ´Ñª$'£•ˆÇ#$_í"k²¨‹ôM[9æ<åå-x½õªm=3 ·Áà ™Ï&`V2áqù®0×!øyìÞY9gßVl¤Öcƒæ4}biâÔ!ºv>‚W²@zÕv›J¢«¬ÕPÊíqó„j¨ÉrNRNæÒž³½÷Û`_*';‹Øðn Öáø“N·yŒÖ+µAÓO“N’©ëÜW¸èÞâÓˆ¤˜ãÅÖÁ.¥¨ädM>ÖšïÉ\F2J}äItVDwD´N4³ž›ÆÿÀ´àzáTÞ¢Á©‘Hó…d8 60re²Õ<—¬ºTùaý‹"mpáYØÂÈ€‹Ñ#·ÀFá»èVo:aŽ ]k-A‘Å?ú—­Ù·ø^}•.8B&c€V¹ú"„· ÇË1UjÙb>^óWíòêͶ¸ý„R jiÜ»säâ€)cN\¯}¨ƒˆdF9$ÂqåÄžmÕSôöff•…uY“Œ®’\{r´—Ôâ_¤“ÌF%vÍIóe‹´D]‚¤ƒÏ¨N7!?Vvf.a¶"ÔÔâ"ú‚ŠÅFzžÞi6þ”µˆãÍ0#ÙÙÑ;Ø }·¥Ô_°fñÎÅ æ% *‘ÉrîíM°#KÖZ¦[?cO£gØs„Lbö¥m³ÃˆnÛpFðÓ²YØ5ú½Ó(Rò$ª=%© ¶¿» Ù4®$ÔqôÜÙWŠŽo¯f –ئ­í[“?A`äÓÂÞ*§yƒ+ÈuµRR™[ÆðN?óþž¯¹´'’R}S¸åígêDù†ZÝ.u%éÛꘌTË•¢‡c(± ‘cPK£¦ÕdŤUõ€±û¿ PŠÛã.„<åúm~aôÌÙ”óW ¨å8¡a8¢d‘õVÿU3Íû÷!6ôìðb¢ àš'Ü”—œ½=öÅJÓXÁœ4»À®NÊjb«GâýŒBl72E/*ÆÇn„ K½ à1“ÞY±ïy\ÈGT¤Ypi.–ù CffÝ3DüJÈ!:©ä%f•ß(nÞ«˜zÿŒj¸ÃóK:ìK×È0@£3Ë•‹ÆèI¦2¡ª‚¦K?ÈÝIJè’mÉ[ŠÈÆÜ°£Â y@R¤Ê}w¼¼@ä¥ý}Ìë~ÊrKÒÒ>ö,ƨ ƒ•=5_UðýW—W’æ-SGM³Õ†a=L§U½LÌpµ4v­oµÔ×Ê °±·Qrgp”‡7íÐŽ¶ŸÌ¡äpýá(oßÏ2W† ä#—]gº»¾pÆëmž)eí!ѹ—Ù…4>·…O³»Ë u„Øhmýª{Ÿ¸Ñ©Á7ÕCá É{ï@ÛþD+²>èÆ\¯¬°}¨ìÅê'¯åI:VSo›’D"ëù0a ®@O­_üÔ|cBoŒ½w²?JÉ“OJe¦j`ëG6ÉÔ¾”uÞXcÎú%ý^ÅI`ôœ^ÍKÄ mM²Ê^<ûf·Høâ¢Ûjù«Acºš.oçÓ¶Mèñ‡ü›»§Ü;ÙßÎkó—(tÄq‚² 8Lb•­|C9Âاq™ù¹*òsŽß6 9ðË/P@—í÷(3âš"ööF)$_}ª ~s "p!d2À(1À.ÁªÙuYáSIÓQXü7ÙpwæÑ3øKB G.¥âõŒsDsŠú)–” Œ®dŒ7tGÆn?-îÚõWeOPŸi8¥YzÇš8^ hTÍk_">Mÿæ,²‰™‰v¹{=ŒÃ½ËÉ»q/*·žØ–ú[QfXSí©­6/; …&k™Ù…”Ân==p àî¡[9²à-æl dü5Vïž±5ìs’Ú¢éäX+YíÍƤxí¢úÒº *Õ"ˆü(˦Һ}3¹p+žNã36óH\Þ¿ø&°S½Ëÿ4,>ØxÝÔªq”üN‚ ²8úáÔØt t¥ ò Š•óy~¯òMÒŽ8rÆXžy±Ñµ®÷7dq1ö¯ÜK³œ×þ=­% çH_IÉS½t]’™@h"ÒuœƯªí½ÌP6UŒ•-Fé£ë?ÑÉëÄýÀˆósIÏê)¬®r-.xTÞÔ,+3½WËH'Q¾l̬’¬0sUNŒZ¨3ö·h¾Óè ܈-üøóMBðÕ { ›¼Óþ¶Ê7^ѹ¶S=óuž8”f°ÞoÄ"†?º¤ï Œþ÷ÝÐD¡Œ¥ðýÅ$èzV‹¯ŠTl9cËžUç'F}¦½AÛE 1ZÇb€ºV()Œ-Q´3ß6Mp!Ö˜ A9kuÛˆÜtgÊè]ŒS<¯Š‹à%eµÂ÷"R—ÍÕ°<ÞiÞO´ÂŒÈ-μùŒàÖÉ¿¶Jð¦¶NF„³ ´¿`*b_[•àÖÙøDæ«©¬ºjºŒ˜²ÿw¨ ÇIf%u¹.…ç¬KŽz:E]©’@pŠPOr¬¸˜Ä÷îØ|=¯êñæh› »AÜ5ü€štÓnñL•DŸ#…Ü-# Ìþ`!Ïž˜ :ä´’øY7­àþþÏvÂÚ*ÑÁÆ“¥Êgo4$¬kUáö㫘RlÄ<Õ¨"~оßtˆ¿pDÏÆÍ&ºTÖ9~ifUuòL$›ÿ5öžXù´A·‚åD»×®†û£ã¢½Ó“ógüK=ª•ûÓç.Àä­\¦Ëé]‘]¼¬N¾'’¯_hQ‰¤L¦¤{3æ’gâ#)ˆü:=”»_±dòEÖŒËCl yug:oÀOm o{Fs«–·¶&S‘ÿn ô†ý’}SŽ÷ÞÇðBÎÃqÔySt•âŒjwÆêúì)ùC*ƒh:‚»™ÿ8~3öQƒzËÝí8 ý@›´M·¬ý˜@¥"ÆâFù£`WówÝÐVóvq¤¯vÐ áôm϶ ò¯1\8‹¢(`½_€Ç(H“G¯ç]… ʪ¹ÄžT@[·i¸/Vs‰˜*9–Z›œ ¢ÛÆ/²RAŠ™FSXiº‡†»°+ ¿òkþ'W²çD§XW‘Bê²]Ó° Æk»±L¶/pw:„- g½Žco¾Ú"Åã7ëÒbðÓRÔO+KÒØcà8Úô””ÜC?yÒjâÜ((tÁÖÑÖàö46Ö—Àª›G¸Ôî3™‚æ"Jж@36p÷ N^;¬Ctˆ6ç ´ÕøÀ[bq¾0;sâãl2>Øuº[îk­ri­^BOŽÿP!U)y|Kb‘Lnˆ:ªq­¶NG2ª.Pê-;ìG¸Ì†ø>¬Ylì%£è…°=­O¿†õ/s­ÙjwÊ¿+OQù©hK÷fŸÑèCÛ„á¡]×@’·©Ël_VI!À We3êÁ ·qõÍDîT$·âÁ}Ž¾ŸDlýq"J«ó }ä=O-k¡‹EB€z¡´ÿßv˜Æl“×^M²iDÑHÓ§{IÀÆ`KãÄÀ–í@qÒq'‡ñ­¤ã'%FæËi¸S3 Mþ&SÈÖ0F…í?2ÙeEkôͤÀ s,;!ò,_ê’ÀÏÍt£Ð/©Ž]R=Œ<„ÿ<„†µûÜf­Ø$™xÆTŸ'¼~Ôüó”u pÙò´ €44X9ö L‚_GÏI+…HÊá:G=xŽœŒ¿Î¥•OqdU;%Û׉£Ûwç†"Â:ó«&M–Ðá篕V­HùÏïBüYBoeßpv­ge?²¿L 7DD:ËhpØI]ÊüyÚç/ìEè@'Åp2Éô·àCj¼WÀݲ¦èל—Ôše¬0Af£ÿ‘4øRcSæy<îÁç@°±VÄ9MW¼½JÊUÏRŽ/g8„DïDg ÒÝø”´x¥1¡75—XÈ[F—¥ØyÖiD–0“˜@!]¹¬ßcW›ÇB¦æ^—öû|ïKΓä×-‰IT»àî&öõ{fÀu;Èéýâ‹v©|£X°ÿ¡FÜôÀ{l³pîYFf¦[:Ó0äócm¡Ôr¸â˜•²fCœÅù{»õ~‡;4Èy%f—4÷,Xó¢ñuæ“æh¤¿7´Ùù*0Q•1©Èµ|2uÒíé5Óöz2Á03±œgB+ó~Xy»,´ÛKÃóûEàœý°t¦¼tùšA´/&ˆì”³ˆ:l[¿<*z%1]K "/‘½dAÁØhäÕxáÁ¼ø“\±-¦ÖÛ*ü«{Ìi*ÅZý¤tÁT(XÀoÞ&6ɤ›ÑeºB‹z!Ñ‹‚õ8îj–GÿG!-ËùÇezÏ?ÎîRµÓ$=š¦ {<ĸu—úÏÄ ˆú¹<ü°/`¢°__h JÃÈRkRhÎ#”-{l'¥Qu{îë?RÇÚЬ:Äòæú‡Sƒ¼€+Rõƒ–)úŽO÷4Ëà•v´FÂÇãƒr™Y âz&h5ú&¹˜¯›•&0J[t@‘?`9W¢ÁˆI%Œƒºò=TûYX(c$„Ô»–øú\H¨÷ Õ²ù‚¯?r”Dÿ³®Ù¶V¼Ñzð§ÕS^~xÍ„s{vHéÞr —óo@·(ÿ¼Ìˆ£ä–D€â\h¯—µ€úCwàNjC"­º–¸[?—ÊÃX ±U72ÿ¥9 Jo’±)wQé,,L\þ=…¥Ë PÍÏB·Îš9°“JÁ«ç²ÇIËÆvðÁ¯‰ù XlTþ# ·ëísƒ'îW«µÌ6„½u=æ?A¥ 8•Ä äªÖúR†eìÉÒw=Fõê?9n¹i½¯"îQä“<`™Îø'ÞuFL°(Ý)ã1&¼Ö¡{I(JâsÉU··eZŸûÇ5T"n’'¬£MÄÒ>åAÕl]·ô=  ˆHv$ŠÝ¼adn»¤ÿ_^‹YŽu¼•» uÓ;‘†±è6¢_Œ•òS0Ø[ÇE „èÛIÖ!*»˜æÔê*éq\ÕîÀ#a}ãÔwéG“G»ÅÈÍ€®þS,ò"ÀJ!™+ú‘À0°¹Hh§ðä(‘wô #U „¨»›3)®|·ÚÉcßjJW[Iü¿žrìàÅ»ä:Ò|@zÆäŠC~€a>Aò×?[蹺ýaÿ}?•Ñ,Ç\h—¹ýIÎÿ󺡹8´žÏU&6÷CÔ5K=ñ¿¦S>Ø Vý’ÇÚ}-¡‹‡_,ŠìÇ×!š~=Áç1XÿøäýT S³8õ<•D‡°À§¬VàÄ}èÛàbÍÄIø€6 ¾*r?Fü‚ýW ƒù>´e|ã€ñê¦h,N¼o}÷ùŠ„N‡êÛ¿9E£÷&“^HˆLm*%Ø^Ó܈Ïv‚/N¢“‰toÉ1ÏÓ‘•åÊ‚JèE%kà÷©kÝšX¬/ lï[ _{þqkR²|è0Û€‹ñ Ó0Ò”§÷Ò0«Ò{žk4HVÉ_ÒáœzÒÏ{F•ÎÖÌØ_\]*½¶W-èÉ>ï &‚`µM´ñ‚t oUHsÔ‚+Yª¤çÑE|âkÆü¬‚‚ëÁ’ÅëÚwÐîQîÿx a¢ œŠš=ú+èb4p &F2–l¨ój£9Œê…!hç|…!-`ð3tÆ×WwÄ-jÿjÜÐ,Eˆï®“SS[Ò³™Ûˆ=˸:ã+LsÕâ [£ü¢¬+ -³äÙóú¸kIi겂ßfÊèáÝíþ%tøû¥IjYçô#E‡û*uá}Ï’}c áQ5Âd Ø.·KèC°æýeºCòIª˜Ï0>®+ÊÎÊ’»Ü K’éU*xEÊŠ»í17¯ Né×M®³ðK/O_x̲½¼ÿý)ÛÍäPªØzIý|¬¯ æS ü%Å\…l[2³ªßñ|§À»I 3Üoh;,j¦ 1°”ƒÑ¨Lx7pvpyFÞsE H*M$>‰à••'®÷e:w fTã!UrLù!”ª&ÚülD×Fä%¼ ¦ìaάm9w"5áðösâ©>÷¯È¸¬¸|“Þ펻Ø8îÞÃå6ÁÞ_°FyÛíüÃV¸8A ±›´¼w9Ð_Óa¿˜ûœÌ ¿=¬IzNøéL¢—ˆc\ýGg3gŸ8Ýýv$¶í#'—÷H‘f@8ÆEµ¡îG1—M—Jƒv"§uô—*\熕¬ÀCÞG"µ¯Å7˜"³[Cš6M¿·Ðüód­·¹y.‹bQV,ï¿ÆÎxœWl¢QvËêQmvÖ“û€º¶ò|¡ÀÌ~OÎê³€NƒoCç÷#ßnN>‚ÿiyI¡–·4ø|B$)=Ù'’ Úèߤï$Š\0Øñ£ˆ©ö½‚ ßyÚçnmÀo ªSOà8ÑòbKÜfRo°5üÇUVclW;Ðeì1 {,™dÙ· r+Óô!"Œm…/õ´X†q$å;ÚI·ÍÞÈdª’ÔæÆnü Nc­YÐ.—äë”ê9R `¸¯¬M™WÖ‡;9ß"ÃyAz•ˆ SöA‰F(rªH÷ç¿¿À^~D¼µXœ0.~Nqs¶þ'ëÆSþÈ€0'°HÌu]'ÑæD &é$nJåZÃhÁy"ÉN, z(h$“ðˆŠøW²[àšÁHj1MžT“žßr "¿ZÞ…ö¿QG¯t¶M`ð6´6ü3S”/_XÅJwz"Elgl~õ¾ïYuÂEc@¥µ: ÔúcNš·7œöß}´!~±­ knô{šŠn¸@ŸÌ˜ö/lX©>ÂNüPê%§=¶…‹\¯sŽÏ{ªZºYzÐB9A/"p ŒV^EøÖÙKËãÀ¡8l•a´2Ì "2“õÊynÔÒ÷~bužt—‘sõÞàõŽ¢ëå6/õÛ>OåÇUÞ^åÖÑJ—Áa#æ)¡&‹Â-ˆžè‚ˆ,õ<ȸ $?ëNÉú³5éM0^9w;©Ð±¦Ç# \ŒÝþü“ßPVN û‡|Jø!6ØF¶¤U  ¨i×59€›”RßËbØÉ@ŠÕ2 P\aƒ$×Î~–Äöêlr D‹ R½-‚›@¯Ý˜¾ÄLÊ ÈÛ´Hn Óª„mÆ\dÙ²#(3‚Oú‘™Edï{›à`î‰J!a<.Å/d/½ø&kG!Ötpëù³V®#@zíJÀJLÍ+ï\«”@ÛZFø¼>Íÿu„?{– jÁüúÅRPÀ¶j^.Ø;7ÉC:D«ÚÀ ·%Ï㶫IP=ƒ¦ßvØ”äåšÎÕI ±B­þ/gGÍ÷ÙAë è:¶x›a_O>Ã]¦>V¶|7Ë÷—Ivå0Ü·[í(c2No¡h™ýCdÀ¸l,Œµ4Ò’³²P„‹)§.Œ+ m§DÒ~—.0zÔk2M—žÕ¸“³ oËÔ+ýº)!ýpü]Cúéýtœ]™ ;Š‰Ÿô),ãäKÔ…ýdÕôyØã†ËÕd¼¼ŠÌIGÛ”ôŠ52ß³¾¿´ÙJ@HD$DOä%Ÿ…ÀÙÌŠ Q ³Eݤ¬ÁÄ`jÇ%ý™A'{P’®€ÿxÓ'§PÚ†päBj/zʱµABfðéúC¬[% JòêuÇ¿t=‚õih‰‡=v>ÄœYj 1PT*kb_±z8ž\¿WW‰Ûï9§¼M“ÐCj©ÅVëÛö}ë¢ù¯.}JO7E5Õ)áåjÍMxŽHÔü G‰ñüvDOzï:W¹Œ÷çÑ ÿþAà›#÷¹ÊWï7á«BƒÒ3ÌbÜäØ7"µ»M’æT¡G%¹n,cõ(™ïp1 ìã Fq©kÎix?àA9º]·œ½@3€“©ù-ö/—>0 ‹YZpolyCub/R/polyCub.midpoint.R0000644000176200001440000000651713164400262015461 0ustar liggesusers################################################################################ ### polyCub.midpoint: Two-Dimensional Midpoint Rule ### ### Copyright (C) 2009-2015,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ #' 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} (Baddeley and Turner, 2005). #' The integral under the surface is then approximated as the #' sum over (pixel area * f(pixel midpoint)). #' #' @inheritParams plotpolyf #' @param polyregion a polygonal integration domain. #' It can be any object coercible to the \pkg{spatstat} class #' \code{"\link[spatstat]{owin}"} via a corresponding #' \code{\link[spatstat]{as.owin}}-method. #' Note that this includes polygons of the classes \code{"gpc.poly"} and #' \code{"\linkS4class{SpatialPolygons}"}, because \pkg{polyCub} defines #' methods \code{\link{as.owin.gpc.poly}} and #' \code{\link{as.owin.SpatialPolygons}}, respectively. #' @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 #' Baddeley, A. and Turner, R. (2005). #' \pkg{spatstat}: an \R package for analyzing spatial point patterns. #' \emph{Journal of Statistical Software}, \bold{12} (6), 1-42. #' @keywords math spatial #' @family polyCub-methods #' @import sp #' @importFrom grDevices gray #' @examples # see example(polyCub) #' @export ## NOTE: we don't import graphics::plot since it is already imported via sp 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( spatstat::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) { spatstat::plot.im(IM, axes=TRUE, col=gray(31:4/35), main="") ## add evaluation points #with(IM, points(expand.grid(xcol, yrow), 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 spatstat::integral.im(IM) } polyCub/R/xylist.R0000644000176200001440000001100313164400262013540 0ustar liggesusers################################################################################ ### xylist: Convert Various Polygon Classes to a Simple List of Vertices ### ### Copyright (C) 2012-2014,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' 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{"\linkS4class{Polygons}"} from package \pkg{sp} ##' (as well as \code{"\linkS4class{Polygon}"} and ##' \code{"\linkS4class{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}. ##' @author Sebastian Meyer ##' @name xylist ##' @keywords spatial methods ##' @export xylist <- function (object, ...) UseMethod("xylist") ##' @rdname xylist ##' @export xylist.owin <- function (object, ...) { spatstat::as.polygonal(object)$bdry } ##' @rdname xylist ##' @export xylist.gpc.poly <- function (object, ...) { xylist.owin(gpc2owin(object, check = FALSE)) } ##' @rdname xylist ##' @inheritParams xylist.Polygons ##' @export xylist.SpatialPolygons <- function (object, reverse = TRUE, ...) { unlist(lapply(object@polygons, xylist.Polygons, reverse=reverse, ...), recursive=FALSE, use.names=FALSE) } ##' @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 ##' @export 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 }) } ##' @rdname xylist ##' @import methods ##' @export xylist.Polygon <- function (object, reverse = TRUE, ...) xylist.Polygons(as(object,"Polygons"), reverse=reverse, ...) ##' @rdname xylist ##' @importFrom grDevices xy.coords ##' @export 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.R0000644000176200001440000002010113164367551016021 0ustar liggesusers################################################################################ ### polyCub.exact.Gauss: Quasi-Exact Cubature of the Bivariate Normal Density ### ### Copyright (C) 2009-2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ #' Quasi-Exact Cubature of the Bivariate Normal Density #' #' Integration is based on triangulation of the (transformed) polygonal domain #' and formulae from the #' Abramowitz and Stegun (1972) 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: \eqn{(AOB+BOC-AOC)} or \eqn{(AOB-AOC-BOC)} or #' \eqn{(AOB+AOC-BOC)} or \eqn{(AOC+BOC-AOB)} or \ldots. #' However, the most time consuming step is the #' evaluation of \code{\link[mvtnorm]{pmvnorm}}. #' #' @note The package \pkg{gpclib} is required to produce the #' \code{tristrip}, since this is not implemented in \pkg{rgeos} #' (as of version 0.3-25). #' The restricted license of \pkg{gpclib} (commercial use prohibited) #' 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 #' transformed (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 stemming 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 #' Abramowitz, M. and Stegun, I. A. (1972). #' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical #' Tables. 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 graphics lines #' @export ## NOTE: we don't import graphics::plot since it is already imported via sp polyCub.exact.Gauss <- function (polyregion, mean = c(0,0), Sigma = diag(2), plot = FALSE) { gpclibCheck(fatal=TRUE) if (inherits(polyregion, "owin")) { polyregion <- owin2gpc(polyregion) } else if (!inherits(polyregion, "gpc.poly")) { if (inherits(polyregion, "SpatialPolygons") && !requireNamespace("rgeos")) { stop("package ", sQuote("rgeos"), " is required to handle ", "\"SpatialPolygons\" input") } polyregion <- as(polyregion, "gpc.poly") } ## coordinate transformation so that the standard bivariat normal density ## can be used in integrations (cf. formula 26.3.22) polyregion@pts <- transform_pts(polyregion@pts, mean = mean, Sigma = Sigma) ## 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 <- vapply(X = triangleSets, FUN = function (triangles) { int <- 0 error <- 0 nTriangles <- nrow(triangles) - 2L for (i in seq_len(nTriangles)) { res <- .intTriangleAS(triangles[i+(0:2),]) int <- int + res error <- error + attr(res, "error") } c(int, nTriangles, error) }, FUN.VALUE = numeric(3L), USE.NAMES = FALSE) int <- sum(integrals[1,]) ## number of .V() evaluations (if there were no degenerate triangles) attr(int, "nEval") <- 6 * sum(integrals[2,]) ## approximate absolute integration error attr(int, "error") <- sum(integrals[3,]) return(int) } ########################### ### Auxiliary Functions ### ########################### ## transform coordinates according to Formula 26.3.22 transform_pts <- function (pts, mean, Sigma) { mx <- mean[1L] my <- mean[2L] rho <- cov2cor(Sigma)[1L,2L] sdx <- sqrt(Sigma[1L,1L]) sdy <- sqrt(Sigma[2L,2L]) lapply(pts, function (poly) { x0 <- (poly[["x"]] - mx) / sdx y0 <- (poly[["y"]] - my) / sdy list(x = (x0 + y0) / sqrt(2 + 2*rho), y = (y0 - x0) / sqrt(2 - 2*rho), hole = poly[["hole"]]) }) } ## calculates the integral of the standard bivariat normal over a triangle ABC .intTriangleAS <- function (xy) { if (anyDuplicated(xy)) # degenerate triangle return(structure(0, error = 0)) 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) { BmA <- B - A d <- sqrt(sum(BmA^2)) h <- abs(B[2L]*A[1L] - A[2L]*B[1L]) / d # distance of AB to the origin if (d == 0 || h == 0) # degenerate triangle: A == B or 0, A, B on a line return(structure(0, error = 0)) k1 <- dotprod(A, BmA) / d k2 <- dotprod(B, BmA) / d V2 <- .V(h, abs(k2)) V1 <- .V(h, abs(k1)) res <- if (sign(k1) == sign(k2)) { ## A and B are on the same side of the normal line through 0 abs(V2 - V1) } else { V2 + V1 } 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) { if (k == 0) # degenerate triangle return(structure(0, error = 0)) 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), 2L, 2L) ) Qh <- pnorm(h, mean = 0, sd = 1, lower.tail = FALSE) return(Lh0rho - asin(rho)/2/pi - Qh/2) } polyCub/R/plotpolyf.R0000644000176200001440000000753313164371300014251 0ustar liggesusers################################################################################ ### plotpolyf: Plot Polygonal Domain on Image of Bivariate Function ### ### Copyright (C) 2013-2014 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' 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}}. ##' ##' @param polyregion a polygonal 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 a two-dimensional real function. ##' As its first argument it must take a coordinate matrix, i.e., a ##' numeric matrix with two columns, and it must return a numeric vector of ##' length the number of coordinates. ##' @param ... further arguments for \code{f}. ##' @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. ##' @param print.args a list of arguments passed to \code{\link{print.trellis}} ##' for plotting the produced \code{\link[lattice:trellis.object]{"trellis"}} object ##' (given \code{use.lattice = TRUE}). The latter will be returned without ##' explicit \code{print}ing if \code{print.args} is not a list. ##' @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, print.args=list()) { 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(as.matrix(xygrid, rownames.force = FALSE), ...) ## plot if (use.lattice && requireNamespace("lattice")) { mypanel <- function(...) { lattice::panel.levelplot(...) lapply(polys, function(xy) lattice::panel.polygon(xy, lwd=lwd)) } trobj <- lattice::levelplot(fval ~ x*y, data=xygrid, aspect="iso", cuts=cuts, col.regions=col, panel=mypanel) if (is.list(print.args)) { do.call("print", c(alist(x=trobj), print.args)) } else trobj } 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.R0000644000176200001440000000651513164400262013360 0ustar liggesusers################################################################################ ### Internal Functions ### ### Copyright (C) 2009-2015,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' 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 Polygonal Domain (of Various Classes) ##' ##' @inheritParams plotpolyf ##' @param add logical. Add to existing plot? ##' @import methods ##' @import sp ##' @importFrom graphics polygon ## NOTE: we don't import graphics::plot since it is already imported via sp plot_polyregion <- function (polyregion, lwd=2, add=FALSE) { if (is.vector(polyregion, mode="list")) { # internal xylist object stopifnot(add) lapply(polyregion, polygon, lwd=lwd) invisible() } else if (inherits(polyregion, "gpc.poly")) { 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)) if (inherits(polyregion, "owin")) ## && ! "plot.owin" %in% getNamespaceInfo("spatstat", "S3methods") plot <- spatstat::plot.owin # spatstat <1.33-0 has no registration ## plot call which works for "SpatialPolygons" and "owin" 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.R0000644000176200001440000001000713164400262015657 0ustar liggesusers################################################################################ ### Conversion between polygonal "owin" and "gpc.poly" ### ### Copyright (C) 2012-2015,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' Conversion between polygonal \code{"owin"} and \code{"gpc.poly"} ##' ##' 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}). ##' Support for the \code{"gpc.poly"} class was dropped from ##' \pkg{spatstat} as of version 1.34-0. ##' ##' @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 ##' @note The converter \code{owin2gpc} requires the package \pkg{rgeos} (or ##' \pkg{gpclib}) for the formal class definition of a \code{"gpc.poly"}. ##' 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}}, and the package \pkg{rgeos} for ##' conversions of \code{"gpc.poly"} objects from and to \pkg{sp}'s ##' \code{"\linkS4class{SpatialPolygons}"} class. ##' @name coerce-gpc-methods ##' @rdname coerce-gpc-methods ##' @keywords spatial methods ##' @import methods ##' @export owin2gpc <- function (object) { object <- spatstat::as.polygonal(object) ## determine hole flags of the individual polygons hole <- spatstat::summary.owin(object)$areas < 0 ## reverse vertices and set hole flags pts <- mapply( FUN = function (poly, hole) { list(x = rev.default(poly$x), y = rev.default(poly$y), hole = hole) # or spatstat.utils::is.hole.xypolygon(poly) }, poly = object$bdry, hole = hole, SIMPLIFY = FALSE, USE.NAMES = FALSE) ## formal class if (know_gpc.poly()) { new("gpc.poly", pts = pts) } else { warning("formal class \"gpc.poly\" not available") pts } } ##' @inheritParams owin2gpc ##' @param ... further arguments passed to \code{\link[spatstat]{owin}}. ##' @rdname coerce-gpc-methods ##' @export gpc2owin <- function (object, ...) { ## first convert to an "owin" without checking areas etc. ## to determine the hole status according to vertex order (area) res <- spatstat::owin(poly = object@pts, check = FALSE) holes_owin <- spatstat::summary.owin(res)$areas < 0 ## or directly lapply spatstat.utils::is.hole.xypolygon ## now fix the vertex order bdry <- mapply( FUN = function (poly, owinhole) { if (poly$hole != owinhole) { poly$x <- rev(poly$x) poly$y <- rev(poly$y) } poly }, poly = object@pts, owinhole = holes_owin, SIMPLIFY = FALSE, USE.NAMES = FALSE) ## now really convert to owin with appropriate vertex order spatstat::owin(poly = bdry, ...) } ##' @inheritParams gpc2owin ##' @param W an object of class \code{"gpc.poly"}. ##' @rdname coerce-gpc-methods ##' @export as.owin.gpc.poly <- function (W, ...) { gpc2owin(W, ...) } ## 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.R0000644000176200001440000000446513163463617014131 0ustar liggesusers################################################################################ ### Integration of the Isotropic Gaussian Density over Circular Domains ### ### Copyright (C) 2013-2014 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' 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 ##' (1972). ##' ##' @references ##' Abramowitz, M. and Stegun, I. A. (1972). ##' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical ##' Tables. 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 (requireNamespace("mvtnorm") && 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.R0000644000176200001440000001042713164451365013064 0ustar liggesusers################################################################################ ### Package Setup ### ### Copyright (C) 2009-2014 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ #' 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} (Baddeley and Turner, 2005). #' 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, see Meyer and Held #' (2014, Supplement B, Section 2.4). #' } #' \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 (1972) 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 #' Abramowitz, M. and Stegun, I. A. (1972). #' Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical #' Tables. New York: Dover Publications. #' #' Baddeley, A. and Turner, R. (2005). #' \pkg{spatstat}: an \R package for analyzing spatial point patterns. #' \emph{Journal of Statistical Software}, \bold{12} (6), 1-42. #' #' Meyer, S. (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/}. #' #' Meyer, S. and Held, L. (2014). #' Power-law models for infectious disease spread. #' \emph{The Annals of Applied Statistics}, \bold{8} (3), 1612-1639.\cr #' DOI-Link: \url{https://doi.org/10.1214/14-AOAS743}, #' \href{https://arxiv.org/abs/1308.5115}{arXiv:1308.5115} #' #' Sommariva, A. and Vianello, M. (2007). #' Product Gauss cubature over polygons based on Green's integration formula. #' \emph{BIT Numerical Mathematics}, \bold{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.R0000644000176200001440000000730213164400262015534 0ustar liggesusers################################################################################ ### as.owin.SpatialPolygons: Coerce "SpatialPolygons" to "owin" ### ### Copyright (C) 2012-2013,2015,2017 Sebastian Meyer ### ### This file is 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 https://www.R-project.org/Licenses/. ################################################################################ ##' Coerce \code{"SpatialPolygons"} to \code{"owin"} ##' ##' Package \pkg{polyCub} implements \code{coerce}-methods ##' (\code{as(object, Class)}) to convert \code{"\linkS4class{SpatialPolygons}"} ##' (or \code{"\linkS4class{Polygons}"} or \code{"\linkS4class{Polygon}"}) ##' to \code{"\link[spatstat:owin.object]{owin}"}. ##' They are also available as \code{as.owin.*} functions to support ##' \code{\link{polyCub.midpoint}}. However, these are no registered S3 methods ##' for \code{\link[spatstat]{as.owin}}, since package \pkg{spatstat} is ##' optional. ##' Note that the \pkg{maptools} package contains an alternative implementation ##' of coercion from \code{"SpatialPolygons"} to \code{"owin"} (and reverse), ##' and \R will use the S4 \code{coerce}-method that was loaded last, ##' and prefer the \code{as.owin.SpatialPolygons} S3-method exported from ##' \pkg{maptools} if attached. ##' @author Sebastian Meyer ##' @keywords spatial methods ##' @name coerce-sp-methods ##' @rdname coerce-sp-methods ##' @exportMethod coerce NULL ##' @param W an object of class \code{"SpatialPolygons"}, ##' \code{"Polygons"}, or \code{"Polygon"}. ##' @param ... further arguments passed to \code{\link[spatstat]{owin}}. ##' @rdname coerce-sp-methods ##' @export as.owin.SpatialPolygons <- function (W, ...) spatstat::owin(poly = xylist.SpatialPolygons(W), ...) ##' @rdname coerce-sp-methods ##' @export as.owin.Polygons <- function (W, ...) spatstat::owin(poly = xylist.Polygons(W), ...) ##' @rdname coerce-sp-methods ##' @export as.owin.Polygon <- function (W, ...) spatstat::owin(poly = xylist.Polygon(W), ...) ## 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' ##' @importClassesFrom sp owin ##' @name coerce,SpatialPolygons,owin-method ##' @rdname coerce-sp-methods setAs(from = "SpatialPolygons", to = "owin", def = function (from) as.owin.SpatialPolygons(from)) ##' @name coerce,Polygons,owin-method ##' @rdname coerce-sp-methods setAs(from = "Polygons", to = "owin", def = function (from) as.owin.Polygons(from)) ##' @name coerce,Polygon,owin-method ##' @rdname coerce-sp-methods setAs(from = "Polygon", to = "owin", def = function (from) as.owin.Polygon(from)) ##' @name coerce,Polygon,Polygons-method ##' @rdname coerce-sp-methods setAs(from = "Polygon", to = "Polygons", def = function (from) Polygons(list(from), "Polygon")) polyCub/README.md0000644000176200001440000000552413164451220013152 0ustar liggesusersThe R package polyCub ([CRAN](https://CRAN.R-project.org/package=polyCub)) ===================== An R package providing methods for **cubature** (numerical integration) **over polygonal domains**. Note that for cubature over simple hypercubes, the packages [`cubature`](https://CRAN.R-project.org/package=cubature) and [`R2Cuba`](https://CRAN.R-project.org/package=R2Cuba) might be more appropriate (cf. [`CRAN Task View: Numerical Mathematics`](https://CRAN.R-project.org/view=NumericalMathematics)). The function `polyCub()` is the main entry point of the package. It is a wrapper around the following specific cubature methods. #### General-purpose cubature rules: * `polyCub.midpoint()`: Two-dimensional midpoint rule (a simple wrapper around [`spatstat`](https://CRAN.R-project.org/package=spatstat)'s `as.im.function()`) * `polyCub.SV()`: Product Gauss cubature as proposed by [Sommariva and Vianello (2007, *BIT Numerical Mathematics*)](https://doi.org/10.1007/s10543-007-0131-2) #### Cubature rules for specific types of functions: * `polyCub.iso()`: Efficient adaptive cubature for *isotropic* functions via line `integrate()` along the polygon boundary, as described in Supplement B of [Meyer and Held (2014, *The Annals of Applied Statistics*)](https://doi.org/10.1214/14-AOAS743) * `polyCub.exact.Gauss()` and `circleCub.Gauss()`: Quasi-exact methods specific to the integration of the *bivariate Gaussian density* over polygonal and circular domains, respectively A Short History of the Package ------------------------------ For any spatio-temporal point process model, the likelihood contains an integral of the conditional intensity function over the observation region. If this is a polygon, analytical solutions are only available for trivial cases of the intensity function - thus the need of a cubature method over polygonal domains. My Master's Thesis (2010) on ["Spatio-Temporal Infectious Disease Epidemiology based on Point Processes"](http://epub.ub.uni-muenchen.de/11703/) is the origin of this package. Section 3.2 therein offers a more detailed description and benchmark experiment of some of the above cubature methods (and others). The implementation then went into the [`surveillance`](https://CRAN.R-project.org/package=surveillance) package, where it is used to fit `twinstim()`, self-exciting two-component spatio-temporal point process models, described in [Meyer et al (2012, *Biometrics*)](https://doi.org/10.1111/j.1541-0420.2011.01684.x). In May 2013, I decided to move the cubature functionality into a stand-alone package, since it might be useful for other projects as well. Subsequently, I developed the isotropic cubature method `polyCub.iso()` to efficiently estimate point process models with a power-law distance decay of interaction ([Meyer and Held, 2014, *The Annals of Applied Statistics*](https://doi.org/10.1214/14-AOAS743)). polyCub/MD50000644000176200001440000000537113164457775012230 0ustar liggesusers438d1a14a60e97d70f389dacb2546c8a *DESCRIPTION a6dc3b7fcabb8eafb4c8586a23468f0a *NAMESPACE 19d40f1942c5088c42fe648f43614f51 *R/circleCub.R 59d391e3544ef8697d2371fc7988a3cc *R/coerce-gpc-methods.R 34b824603176d13102c02d1fe5826283 *R/coerce-sp-methods.R 5295a3051e70064937101d985560511d *R/plotpolyf.R 2d6a75533fa044e0ee0f9121c3406131 *R/polyCub.R b4e36eef011f4760b138c6eb3808f9df *R/polyCub.SV.R 3986755656ca13a208d01ab08ccc650f *R/polyCub.exact.Gauss.R b189742e84f65250f5759d071731fcde *R/polyCub.iso.R 7dc5afebd7e92cc577c2067dd829d66d *R/polyCub.midpoint.R 75a1bb73253360d3ffdbb005b55f083f *R/sysdata.rda 81a26c8de73be4ad0b1108b9db90a67d *R/tools.R cf2448d45a3e90a86ea2da7411940de0 *R/xylist.R df516694ba96d2075bf97e14a94d3bd4 *R/zzz.R 95e2ff0fbb02ba4ba5f7c000482d11ba *README.md 915021f57341348a5f9348605269001e *inst/CITATION 5be440a43ef60b2105c25c3665b52f24 *inst/NEWS.Rd 42413ac762b1299f8839a6d44177a5d8 *inst/examples/plotpolyf.R 400ead42d7003be5582e78cd17946c07 *inst/examples/polyCub.R 39e559d406a3917df7a2a6b7d287deae *inst/examples/polyCub.iso.R af7c7fdb25a9f3fc0db625dbc9f26307 *inst/include/polyCubAPI.h 48f7672ddb81a77f3793f2b26f4f9cbe *man/checkintrfr.Rd c9b66a346be26e28e9cfa79cce6d387f *man/circleCub.Gauss.Rd abbb7e1ef363a9db8fb04bae9982e803 *man/coerce-gpc-methods.Rd 6050602f0ebcb375ea741ef5f4136e98 *man/coerce-sp-methods.Rd 323f56fe3449f60180325c6263454377 *man/dotprod.Rd c38994de2c8de6f2372c42eb4ce915a4 *man/gpclibPermit.Rd db65b0e51cfcb8f175e6a32dc5c495e6 *man/isClosed.Rd b31e8ec92525bba018a7368f2d270ce2 *man/isScalar.Rd 31f03498d486eeaef7ba89fec69a3415 *man/makegrid.Rd 6f71baeb60ea79b309dd533de9bc3f0f *man/plot_polyregion.Rd 8f06fae1bf8aa2f50d7a918e598b20af *man/plotpolyf.Rd 8c8741a653a08a5c03806b8036716891 *man/polyCub-package.Rd 115c6cbabf430249998af7f1183c760e *man/polyCub.Rd 492a74b4e140d7f11e10499c27f33c74 *man/polyCub.SV.Rd 6848f055cc0e82f755a292f55224b569 *man/polyCub.exact.Gauss.Rd f253d5184c8bc8fa6e90cb13e242a2f5 *man/polyCub.iso.Rd 33f30984750652e060b59fd0a9fd54b1 *man/polyCub.midpoint.Rd 099c8c3b006996cde118bdb35507b442 *man/polygauss.Rd 3e57be2294c537ed441d6273872bd716 *man/vecnorm.Rd 2b9d9db445fbbaca1411a2273c1198fe *man/xylist.Rd 490daf10f0bef6930c2684af5cc7f477 *src/init.c bd2782f92e09d64dbea9e87f10b66f97 *src/polyCub.SV.c ce25a1a76b4cf52a0f34a1352640227d *src/polyCub.SV.h 2ef3ee5c813c5281bec75b33eb6cb589 *src/polyCub.iso.c c16fcda4cc1fa1bf7c4e7cb9b97294d3 *src/polyCub.iso.h 3e4e9e53ad2f425939503fd77e030cd2 *tests/test-all.R 673cd0874ece8c19399eaf853af0457a *tests/testthat/polyiso_powerlaw.c b56f6ab7f21b2441ccd03873d4a1605c *tests/testthat/test-NWGL.R 4076eacdcf7edcf0e376ecec57521d3f *tests/testthat/test-polyCub.R 4222d51ae8cc74424b8fbf735c1bb55c *tests/testthat/test-polyiso.R 754cef6b76758b994c545474befd1205 *tests/testthat/test-regression.R polyCub/DESCRIPTION0000644000176200001440000000325513164457775013425 0ustar liggesusersPackage: polyCub Title: Cubature over Polygonal Domains Version: 0.6.1 Date: 2017-10-02 Authors@R: c( person("Sebastian", "Meyer", email = "seb.meyer@fau.de", role = c("aut","cre","trl")), person("Leonhard", "Held", email = "Leonhard.Held@uzh.ch", role = "ths"), person("Michael", "Hoehle", email = "hoehle@math.su.se", role = "ths") ) Description: The following methods for cubature (numerical integration) over polygonal domains are currently implemented: the two-dimensional midpoint rule as a simple wrapper around as.im.function() from package 'spatstat' (Baddeley and Turner, 2005), the product Gauss cubature by Sommariva and Vianello (2007), an adaptive cubature for isotropic functions via line integrate() along the boundary (Meyer and Held, 2014), and quasi-exact methods specific to the integration of the bivariate Gaussian density over polygonal and circular domains (based on formulae from the Abramowitz and Stegun (1972) handbook). 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 (>= 1.0-11) Imports: grDevices, graphics, stats Suggests: spatstat, lattice, testthat, mvtnorm, statmod, rgeos, gpclib RoxygenNote: 6.0.1 NeedsCompilation: yes Packaged: 2017-10-02 14:57:04 UTC; smeyer Author: Sebastian Meyer [aut, cre, trl], Leonhard Held [ths], Michael Hoehle [ths] Maintainer: Sebastian Meyer Repository: CRAN Date/Publication: 2017-10-02 15:49:17 UTC polyCub/man/0000755000176200001440000000000013164451365012452 5ustar liggesuserspolyCub/man/coerce-gpc-methods.Rd0000644000176200001440000000335413164400262016404 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coerce-gpc-methods.R \name{coerce-gpc-methods} \alias{coerce-gpc-methods} \alias{owin2gpc} \alias{gpc2owin} \alias{as.owin.gpc.poly} \title{Conversion between polygonal \code{"owin"} and \code{"gpc.poly"}} \usage{ owin2gpc(object) gpc2owin(object, ...) as.owin.gpc.poly(W, ...) } \arguments{ \item{object}{an object of class \code{"gpc.poly"} or \code{"owin"}, respectively.} \item{...}{further arguments passed to \code{\link[spatstat]{owin}}.} \item{W}{an object of class \code{"gpc.poly"}.} } \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}). Support for the \code{"gpc.poly"} class was dropped from \pkg{spatstat} as of version 1.34-0. } \note{ The converter \code{owin2gpc} requires the package \pkg{rgeos} (or \pkg{gpclib}) for the formal class definition of a \code{"gpc.poly"}. 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}}, and the package \pkg{rgeos} for conversions of \code{"gpc.poly"} objects from and to \pkg{sp}'s \code{"\linkS4class{SpatialPolygons}"} class. } \author{ Sebastian Meyer } \keyword{methods} \keyword{spatial} polyCub/man/dotprod.Rd0000644000176200001440000000056213106557311014411 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \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.Rd0000644000176200001440000000662213163445052014357 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.R \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 various 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 octagon <- spatstat::disc(radius = 5, centre = c(3,2), npoly = 8) ## plot image of the function and integration domain plotpolyf(octagon, f, xlim=c(-8,8), ylim=c(-8,8)) ### Two-dimensional midpoint rule testmidpoint <- function (eps, main=paste("2D midpoint rule with eps =",eps)) { plotpolyf(octagon, f, xlim=c(-8,8), ylim=c(-8,8), use.lattice=FALSE) ## add evaluation points to plot with(spatstat::as.mask(octagon, eps=eps), points(expand.grid(xcol, yrow), col=m, pch=20)) polyCub.midpoint(octagon, 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(octagon, f, nGQ=nGQ), digits=16), "\\n") } ## 'rotation' affects location of nodes opar <- par(mfrow=c(1,2)) polyCub.SV(octagon, f, nGQ=2, rotation=FALSE, plot=TRUE) polyCub.SV(octagon, f, nGQ=2, rotation=TRUE, plot=TRUE) par(opar) ### Line integration along the boundary for isotropic functions polyCub.iso(octagon, f, center=c(0,0)) # see ?polyCub.iso ### Quasi-exact cubature of the bivariate Gaussian density ### using gpclib::tristrip and mvtnorm::pmvnorm() if (requireNamespace("mvtnorm") && gpclibPermit()) { print(polyCub.exact.Gauss(octagon, mean=c(0,0), Sigma=5^2*diag(2), plot=TRUE), digits=16) } } \seealso{ Other polyCub-methods: \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.Rd0000644000176200001440000000134213106557311016160 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \name{plot_polyregion} \alias{plot_polyregion} \title{Plots a Polygonal Domain (of Various Classes)} \usage{ plot_polyregion(polyregion, lwd = 2, add = FALSE) } \arguments{ \item{polyregion}{a polygonal 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{lwd}{line width of the polygon edges.} \item{add}{logical. Add to existing plot?} } \description{ Plots a Polygonal Domain (of Various Classes) } polyCub/man/vecnorm.Rd0000644000176200001440000000053413106557311014406 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \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.Rd0000644000176200001440000000556713164451365015764 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \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} (Baddeley and Turner, 2005). 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, see Meyer and Held (2014, Supplement B, Section 2.4). } \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 (1972) 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{ Abramowitz, M. and Stegun, I. A. (1972). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables. New York: Dover Publications. Baddeley, A. and Turner, R. (2005). \pkg{spatstat}: an \R package for analyzing spatial point patterns. \emph{Journal of Statistical Software}, \bold{12} (6), 1-42. Meyer, S. (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/}. Meyer, S. and Held, L. (2014). Power-law models for infectious disease spread. \emph{The Annals of Applied Statistics}, \bold{8} (3), 1612-1639.\cr DOI-Link: \url{https://doi.org/10.1214/14-AOAS743}, \href{https://arxiv.org/abs/1308.5115}{arXiv:1308.5115} Sommariva, A. and Vianello, M. (2007). Product Gauss cubature over polygons based on Green's integration formula. \emph{BIT Numerical Mathematics}, \bold{47} (2), 441-453. } \seealso{ The packages \pkg{cubature} and \pkg{R2Cuba}, which are more appropriate for cubature over simple hypercubes. } polyCub/man/checkintrfr.Rd0000644000176200001440000000341313106557311015236 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.iso.R \name{checkintrfr} \alias{checkintrfr} \title{Check the Integral of \eqn{r f_r(r)}} \usage{ checkintrfr(intrfr, f, ..., center, control = list(), rs = numeric(0L), tolerance = control$rel.tol) } \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 missing, \code{intrfr} is approximated numerically using \code{\link{integrate}} configured with \code{control}.} \item{f}{a two-dimensional real function. As its first argument it must take a coordinate matrix, i.e., a numeric matrix with two columns, and it must return a numeric vector of length the number of coordinates.} \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{rs}{numeric vector of upper bounds for which to check the validity of \code{intrfr}. If it has length 0, no checks are performed.} \item{tolerance}{of \code{\link{all.equal.numeric}} when comparing \code{intrfr} results with numerical integration. Defaults to the relative tolerance used for \code{integrate}.} } \value{ The \code{intrfr} function. If it was not supplied, its quadrature version using \code{integrate} is returned. } \description{ This function is auxiliary to \code{\link{polyCub.iso}}. The (analytical) integral of \eqn{r f_r(r)} from 0 to \eqn{R} is checked against a numeric approximation using \code{\link{integrate}} for various values of the upper bound \eqn{R}. A warning is issued if inconsistencies are found. } polyCub/man/polyCub.exact.Gauss.Rd0000644000176200001440000000571213164364742016551 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.exact.Gauss.R \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 transformed (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 stemming 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 (transformed) polygonal domain and formulae from the Abramowitz and Stegun (1972) 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: \eqn{(AOB+BOC-AOC)} or \eqn{(AOB-AOC-BOC)} or \eqn{(AOB+AOC-BOC)} or \eqn{(AOC+BOC-AOB)} or \ldots. However, the most time consuming step is the evaluation of \code{\link[mvtnorm]{pmvnorm}}. } \note{ The package \pkg{gpclib} is required to produce the \code{tristrip}, since this is not implemented in \pkg{rgeos} (as of version 0.3-25). The restricted license of \pkg{gpclib} (commercial use prohibited) has to be accepted explicitly via \code{\link{gpclibPermit}()} prior to using \code{polyCub.exact.Gauss}. } \examples{ # see example(polyCub) } \references{ Abramowitz, M. and Stegun, I. A. (1972). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables. 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.SV}}, \code{\link{polyCub.iso}}, \code{\link{polyCub.midpoint}}, \code{\link{polyCub}} } \keyword{math} \keyword{spatial} polyCub/man/circleCub.Gauss.Rd0000644000176200001440000000332113163514745015715 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/circleCub.R \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 (1972). } \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 (requireNamespace("mvtnorm") && 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{ Abramowitz, M. and Stegun, I. A. (1972). Handbook of Mathematical Functions with Formulas, Graphs, and Mathematical Tables. New York: Dover Publications. } \keyword{math} \keyword{spatial} polyCub/man/polyCub.midpoint.Rd0000644000176200001440000000376613106557311016206 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.midpoint.R \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 a corresponding \code{\link[spatstat]{as.owin}}-method. Note that this includes polygons of the classes \code{"gpc.poly"} and \code{"\linkS4class{SpatialPolygons}"}, because \pkg{polyCub} defines methods \code{\link{as.owin.gpc.poly}} and \code{\link{as.owin.SpatialPolygons}}, respectively.} \item{f}{a two-dimensional real function. As its first argument it must take a coordinate matrix, i.e., a numeric matrix with two columns, and it must return a numeric vector of length the number of coordinates.} \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} (Baddeley and Turner, 2005). The integral under the surface is then approximated as the sum over (pixel area * f(pixel midpoint)). } \examples{ # see example(polyCub) } \references{ Baddeley, A. and Turner, R. (2005). \pkg{spatstat}: an \R package for analyzing spatial point patterns. \emph{Journal of Statistical Software}, \bold{12} (6), 1-42. } \seealso{ Other polyCub-methods: \code{\link{polyCub.SV}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.iso}}, \code{\link{polyCub}} } \keyword{math} \keyword{spatial} polyCub/man/polyCub.iso.Rd0000644000176200001440000001307513164451365015155 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.iso.R \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{polyregion}{a polygonal 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}{a two-dimensional real function. As its first argument it must take a coordinate matrix, i.e., a numeric matrix with two columns, and it must return a numeric vector of length the number of coordinates.} \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 missing, \code{intrfr} is approximated numerically using \code{\link{integrate}} configured with \code{control}.} \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. This check requires \code{f} to be specified. 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{plot}{logical indicating if an image of the function should be plotted together with the polygonal domain, i.e., \code{\link{plotpolyf}(polyregion, f, \dots)}.} \item{polys}{something like \code{owin$bdry}, but see \code{\link{xylist}}.} \item{.witherror}{logical indicating if an upper bound for the absolute integration error should be attached as an attribute to the result?} } \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 upper bound 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. See Meyer and Held (2014, Supplement B, Section 2.4) for mathematical details. \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' ## intrfr(R) = int_0^R r*f(r) dr, for f(r) = dexp(r), gives 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(R) = int_0^R r*f(r) dr = int_0^R r dr = R^2/2 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(spatstat::owin(poly = letterR)), area.ISO, check.attributes = FALSE)) ## the hole is subtracted correctly } \references{ Hedevang, E. (2013). Personal communication at the Summer School on Topics in Space-Time Modeling and Inference (May 2013, Aalborg, Denmark). Meyer, S. and Held, L. (2014). Power-law models for infectious disease spread. \emph{The Annals of Applied Statistics}, \bold{8} (3), 1612-1639.\cr DOI-Link: \url{https://doi.org/10.1214/14-AOAS743}, \href{https://arxiv.org/abs/1308.5115}{arXiv:1308.5115} } \seealso{ \code{system.file("include", "polyCubAPI.h", package = "polyCub")} for a full C-implementation of this cubature method (for a \emph{single} polygon). The corresponding C-routine \code{polyCub_iso} can be used by other \R packages, notably \pkg{surveillance}, via \samp{LinkingTo: polyCub} (in the \file{DESCRIPTION}) and \samp{#include } (in suitable \file{/src} files). Note that the \code{intrfr} function must then also be supplied as a C-routine. An example can be found in the package tests. Other polyCub-methods: \code{\link{polyCub.SV}}, \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.midpoint}}, \code{\link{polyCub}} } \author{ Sebastian Meyer The basic mathematical formulation of this efficient integration for radially symmetric functions was ascertained with great support by Emil Hedevang (2013), Dept. of Mathematics, Aarhus University, Denmark. } \keyword{math} \keyword{spatial} polyCub/man/xylist.Rd0000644000176200001440000000572713164400262014276 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/xylist.R \name{xylist} \alias{xylist} \alias{xylist.owin} \alias{xylist.gpc.poly} \alias{xylist.SpatialPolygons} \alias{xylist.Polygons} \alias{xylist.Polygon} \alias{xylist.default} \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}. } \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{"\linkS4class{Polygons}"} from package \pkg{sp} (as well as \code{"\linkS4class{Polygon}"} and \code{"\linkS4class{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 } \keyword{methods} \keyword{spatial} polyCub/man/makegrid.Rd0000644000176200001440000000115713106557311014522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \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.Rd0000644000176200001440000000521313163514745014771 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.SV.R \name{polygauss} \alias{polygauss} \title{Calculate 2D Nodes and Weights of the Product Gauss Cubature} \usage{ polygauss(xy, nw_MN, alpha = NULL, rotation = FALSE, engine = "C") } \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 each polygon is chosen if no \code{rotation} is performed, and otherwise the \eqn{x}-coordinate of the rotated point \code{"P"} (see \code{rotation}). 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.} \item{engine}{character string specifying the implementation to use. Up to \pkg{polyCub} version 0.4-3, the two-dimensional nodes and weights were computed by \R functions and these are still available by setting \code{engine = "R"}. The new C-implementation is now the default (\code{engine = "C"}) and requires approximately 30\% less computation time.\cr The special setting \code{engine = "C+reduce"} will discard redundant nodes at (0,0) with zero weight resulting from edges on the base-line \eqn{x = \alpha} or orthogonal to it. This extra cleaning is only worth its cost for computationally intensive functions \code{f} over polygons which really have some edges on the baseline or parallel to the x-axis. Note that the old \R implementation does not have such unset zero nodes and weights.} } \description{ Calculate 2D Nodes and Weights of the Product Gauss Cubature } \references{ Sommariva, A. and Vianello, M. (2007): Product Gauss cubature over polygons based on Green's integration formula. \emph{BIT Numerical Mathematics}, \bold{47} (2), 441-453. } \keyword{internal} polyCub/man/plotpolyf.Rd0000644000176200001440000000541313164435041014765 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/plotpolyf.R \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, print.args = list()) } \arguments{ \item{polyregion}{a polygonal 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}{a two-dimensional real function. As its first argument it must take a coordinate matrix, i.e., a numeric matrix with two columns, and it must return a numeric vector of length the number of coordinates.} \item{...}{further arguments for \code{f}.} \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{print.args}{a list of arguments passed to \code{\link{print.trellis}} for plotting the produced \code{\link[lattice:trellis.object]{"trellis"}} object (given \code{use.lattice = TRUE}). The latter will be returned without explicit \code{print}ing if \code{print.args} is not a list.} } \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 (a rounded version of spatstat.data::letterR$bdry) letterR <- list( list(x = c(3.9, 3.8, 3.7, 3.5, 3.4, 3.5, 3.7, 3.8, 3.8, 3.7, 3.7, 3.5, 3.3, 2, 2, 2.7, 2.7, 2.9, 3, 3.3, 3.9), y = c(0.7, 1.1, 1.3, 1.7, 1.8, 1.9, 2.1, 2.3, 2.5, 2.8, 3, 3.2, 3.3, 3.3, 0.7, 0.7, 1.7, 1.7, 1.5, 0.7, 0.6)), list(x = c(2.6, 2.6, 3, 3.1, 3.2, 3.1, 3.1, 3), y = c(2.2, 2.7, 2.7, 2.6, 2.5, 2.4, 2.3, 2.2)) ) ### 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.Rd0000644000176200001440000000102713106557311015354 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \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.Rd0000644000176200001440000001016313163514745014707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/polyCub.SV.R \name{polyCub.SV} \alias{polyCub.SV} \title{Product Gauss Cubature over Polygonal Domains} \usage{ polyCub.SV(polyregion, f, ..., nGQ = 20, alpha = NULL, rotation = FALSE, engine = "C", plot = FALSE) } \arguments{ \item{polyregion}{a polygonal 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}{a two-dimensional real function (or \code{NULL} to only compute nodes and weights). As its first argument it must take a coordinate matrix, i.e., a numeric matrix with two columns, and it must return a numeric vector of length the number of coordinates.} \item{...}{further arguments for \code{f}.} \item{nGQ}{degree of the one-dimensional Gauss-Legendre quadrature rule (default: 20) as implemented in function \code{\link[statmod]{gauss.quad}} of package \pkg{statmod}. Nodes and weights up to \code{nGQ=60} are cached in \pkg{polyCub}, for larger degrees \pkg{statmod} is required.} \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 each polygon is chosen if no \code{rotation} is performed, and otherwise the \eqn{x}-coordinate of the rotated point \code{"P"} (see \code{rotation}). 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.} \item{engine}{character string specifying the implementation to use. Up to \pkg{polyCub} version 0.4-3, the two-dimensional nodes and weights were computed by \R functions and these are still available by setting \code{engine = "R"}. The new C-implementation is now the default (\code{engine = "C"}) and requires approximately 30\% less computation time.\cr The special setting \code{engine = "C+reduce"} will discard redundant nodes at (0,0) with zero weight resulting from edges on the base-line \eqn{x = \alpha} or orthogonal to it. This extra cleaning is only worth its cost for computationally intensive functions \code{f} over polygons which really have some edges on the baseline or parallel to the x-axis. Note that the old \R implementation does not have such unset zero nodes and weights.} \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}.\cr In the case \code{f = NULL}, only the computed nodes and weights are returned in a list of length the number of polygons of \code{polyregion}, where each component is a list with \code{nodes} (a numeric matrix with two columns), \code{weights} (a numeric vector of length \code{nrow(nodes)}), the rotation \code{angle}, and \code{alpha}. } \description{ Product Gauss cubature over polygons as proposed by Sommariva and Vianello (2007). } \examples{ # see example(polyCub) } \references{ Sommariva, A. and Vianello, M. (2007). Product Gauss cubature over polygons based on Green's integration formula. \emph{BIT Numerical Mathematics}, \bold{47} (2), 441-453. } \seealso{ Other polyCub-methods: \code{\link{polyCub.exact.Gauss}}, \code{\link{polyCub.iso}}, \code{\link{polyCub.midpoint}}, \code{\link{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}. } \keyword{math} \keyword{spatial} polyCub/man/isScalar.Rd0000644000176200001440000000051613106557311014476 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \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.Rd0000644000176200001440000000305013164400262016246 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/coerce-sp-methods.R \name{coerce-sp-methods} \alias{coerce-sp-methods} \alias{as.owin.SpatialPolygons} \alias{as.owin.Polygons} \alias{as.owin.Polygon} \alias{coerce,SpatialPolygons,owin-method} \alias{coerce,Polygons,owin-method} \alias{coerce,Polygon,owin-method} \alias{coerce,Polygon,Polygons-method} \title{Coerce \code{"SpatialPolygons"} to \code{"owin"}} \usage{ as.owin.SpatialPolygons(W, ...) as.owin.Polygons(W, ...) as.owin.Polygon(W, ...) } \arguments{ \item{W}{an object of class \code{"SpatialPolygons"}, \code{"Polygons"}, or \code{"Polygon"}.} \item{...}{further arguments passed to \code{\link[spatstat]{owin}}.} } \description{ Package \pkg{polyCub} implements \code{coerce}-methods (\code{as(object, Class)}) to convert \code{"\linkS4class{SpatialPolygons}"} (or \code{"\linkS4class{Polygons}"} or \code{"\linkS4class{Polygon}"}) to \code{"\link[spatstat:owin.object]{owin}"}. They are also available as \code{as.owin.*} functions to support \code{\link{polyCub.midpoint}}. However, these are no registered S3 methods for \code{\link[spatstat]{as.owin}}, since package \pkg{spatstat} is optional. Note that the \pkg{maptools} package contains an alternative implementation of coercion from \code{"SpatialPolygons"} to \code{"owin"} (and reverse), and \R will use the S4 \code{coerce}-method that was loaded last, and prefer the \code{as.owin.SpatialPolygons} S3-method exported from \pkg{maptools} if attached. } \author{ Sebastian Meyer } \keyword{methods} \keyword{spatial} polyCub/man/isClosed.Rd0000644000176200001440000000066013106557311014502 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/tools.R \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}