From 1ccd4c1c789d787b460bf8c3d207c50cf60a6034 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 7 Feb 2020 12:25:18 +0000 Subject: [PATCH 01/70] Authors@R replaces Author and Maintainer field as machine readable. Version number updated to 0.4. Henrik's email updated to cam.ac.uk --- DESCRIPTION | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 008ddf2..89996f4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,15 @@ Package: IDSpatialStats -Version: 0.3.9 -Date: 2019-11-13 +Version: 0.4.0 +Date: 2020-02-06 Title: Estimate Global Clustering in Infectious Disease -Author: Justin Lessler , Henrik Salje , John Giles -Maintainer: Justin Lessler +Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), + email = "justin@jhu.edu"), + person(given = "Henrik Salje", role = "aut", + email = "hs743@cam.ac.uk"), + person(given = "John Giles", role = "aut", + email = "hs743@cam.ac.uk"), + person(given = "Timothy M Pollington", role = "ctb", + email = "timothy.pollington@gmail.com")) License: GPL (>=2) Description: Implements various novel and standard clustering statistics and other analyses useful for understanding the @@ -14,3 +20,4 @@ Imports: igraph, spatstat Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr +BugReports: https://github.com/HopkinsIDD/IDSpatialStats/issues \ No newline at end of file From 350c6f7de46ad715dcfdc6ce94d634ae649479f2 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 7 Feb 2020 13:26:00 +0000 Subject: [PATCH 02/70] Add ORCID and multiple cre as R allows only 1. --- DESCRIPTION | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 89996f4..6679659 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,13 +2,13 @@ Package: IDSpatialStats Version: 0.4.0 Date: 2020-02-06 Title: Estimate Global Clustering in Infectious Disease -Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), +Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9741-8109", "Co-creator & maintainer"), email = "justin@jhu.edu"), - person(given = "Henrik Salje", role = "aut", + person(given = "Henrik Salje", role = "aut", comment = c(ORCID = "0000-0003-3626-4254", "Co-creator"), email = "hs743@cam.ac.uk"), - person(given = "John Giles", role = "aut", + person(given = "John Giles", role = "aut", comment = c(ORCID = "0000-0002-0954-4093", "Author & maintainer"), email = "hs743@cam.ac.uk"), - person(given = "Timothy M Pollington", role = "ctb", + person(given = "Timothy M Pollington", role = "aut", comment = c(ORCID = "0000-0002-9688-5960", "Author"), email = "timothy.pollington@gmail.com")) License: GPL (>=2) Description: Implements various novel and standard From 774ada3e09244820adb2a30ba15fcfb9a8a3988b Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 7 Feb 2020 13:39:14 +0000 Subject: [PATCH 03/70] Add formatting style to improve UX --- README.md | 36 +++++++++++++++++++++++++----------- 1 file changed, 25 insertions(+), 11 deletions(-) diff --git a/README.md b/README.md index 46827d0..1944cbd 100644 --- a/README.md +++ b/README.md @@ -1,36 +1,50 @@ -## IDSpatialStats +# IDSpatialStats This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. -The current implementation of the package includes a function which simulates infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: 1) the mean of the spatial transmission kernel, which is a measure of fine-scale spatial dependence between two cases, and 2) the tau-statistic, a measure of global clustering based on pathogen subtype. +The current implementation of the package includes a function which simulates infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: -Detailed description of the methods can be found here: +1. the mean of the spatial transmission kernel, which is a measure of fine-scale spatial dependence between two cases, and +2. the tau statistic $\tau$, a measure of global clustering based on pathogen subtype and/or, serotype and/or case onset time. -[The IDSpatialStats R package: Quantifying spatial dependence of infectious disease spread (Giles et al. in review)]() +This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.com/gilesjohnR)) and Justin Lessler (GitHub: @[jlessler](https://github.com/jlessler)) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (GitHub: @[HopkinsIDD](https://github.com/HopkinsIDD)). + +## Detailed description of the methods and relevant literature + +[The IDSpatialStats R package: Quantifying spatial dependence of infectious disease spread (Giles et al. accepted)](https://journal.r-project.org/archive/2019/RJ-2019-043/index.html) [Measuring spatial dependence for infectious disease epidemiology (Lessler et al. 2016)](http://journals.plos.org/plosone/article?id=10.1371/journal.pone.0155249) [Estimating infectious disease transmission distances using the overall distribution of cases (Salje et al. 2016)](http://www.sciencedirect.com/science/article/pii/S1755436516300317) -This package is maintained by John Giles (@gilesjohnr) and Justin Lessler (@jlessler) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (@HopkinsIDD). +[Measuring spatiotemporal disease clustering with the tau statistic (Pollington et al. in review)](https://arxiv.org/abs/1911.08022) -### Installation +[The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) -To install the offical release of the `IDSpatialStats` package, open `R` and type: +## Installation + +To install the official release of the `IDSpatialStats` package, open `R` and type: ``` install.packages('IDSpatialStats') ``` -To install the install the development version, first install the `devtools` package and then install `IDSpatialStats` from source via GitHub: +To install the development version, first install the `devtools` package and then install `IDSpatialStats` from source via GitHub: ``` install.packages('devtools') devtools::install_github('HopkinsIDD/IDSpatialStats') ``` -### Troubleshooting +## Troubleshooting and contributions For general questions, contact package maintainers John Giles (giles@jhu.edu) or Justin Lessler (justin@jhu.edu). -To report bugs or problems with documentation, please go to the [Issues](https://github.com/HopkinsIDD/IDSpatialStats/issues) page associated with this GitHub page and click *new issue*. +To report bugs or problems with documentation, please go to the [Issues](https://github.com/HopkinsIDD/IDSpatialStats/issues) page associated with this GitHub page and click *New issue*. + +If you wish to contribute to `IDSpatialStats`, please get in touch via email and then fork the latest version of the package. After committing your code to your own forked version, submit a pull request when you are ready to share. To assist with inspecting your pull request, please: -If you wish to contribute to `IDSpatialStats`, please get in touch via email and then fork the latest version of the package. After committing your code to your own forked version, submit a pull request when you are ready to share. +* Commit...: + * Often + * Describe what was done and why, but not how + * Use the imperative + * $\leq$ 72 characters + e.g. "*Replace percentile CI with BCa CI, as tau bootstrap distrib. non-symm*" \ No newline at end of file From 42e940ffcb72af10fc3b3d8c61894ee1b503d253 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 7 Feb 2020 14:08:01 +0000 Subject: [PATCH 04/70] Add contribution instructions to save time when inspect. pull request --- README.md | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 1944cbd..7ab164f 100644 --- a/README.md +++ b/README.md @@ -40,11 +40,20 @@ For general questions, contact package maintainers John Giles (giles@jhu.edu) or To report bugs or problems with documentation, please go to the [Issues](https://github.com/HopkinsIDD/IDSpatialStats/issues) page associated with this GitHub page and click *New issue*. -If you wish to contribute to `IDSpatialStats`, please get in touch via email and then fork the latest version of the package. After committing your code to your own forked version, submit a pull request when you are ready to share. To assist with inspecting your pull request, please: - -* Commit...: - * Often - * Describe what was done and why, but not how - * Use the imperative - * $\leq$ 72 characters - e.g. "*Replace percentile CI with BCa CI, as tau bootstrap distrib. non-symm*" \ No newline at end of file +If you wish to contribute to `IDSpatialStats`, please first get in touch via email. Then please: + +1. Fork a copy of the current development version on GitHub +2. Add your functions and edits to your forked copy + * pay attention to existing naming conventions and outputs + * add examples + * line comments are welcome for non-intuitive commands. + * commit to your own forked version: + * often + * describe what was done and why, but not how + * use the imperative + * $\leq$ 72 characters + e.g. "*Replace percentile CI with BCa CI, as tau bootstrap distrib. non-symm*" + +3. Any modified functions must return identical output as the current functions. Check that modified functions return the same output using package `testthat` and consider writing new test cases if appropriate. For new functions, write test cases should test that functions return expected values given expected inputs, and that they behave as expected in boundary conditions. +4. Add conditional stops to functions so that they fail gracefully with unexpected inputs. +5. Submit a pull request when you are ready to share. \ No newline at end of file From 25321a04fc324e7bc2268653c9305ffe3aa463cc Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 7 Feb 2020 14:09:34 +0000 Subject: [PATCH 05/70] Add function styling to differentiate from var names --- NAMESPACE | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index c8558ff..1985ef6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -3,15 +3,15 @@ import("doParallel") import("foreach") import("stats") import("graphics") -importFrom("igraph", "graph.data.frame") # for get.transdist.theta -importFrom("igraph", "shortest.paths") # for get.transdist.theta -importFrom("igraph", "E") # for get.transdist.theta -importFrom("spatstat", "bounding.box.xy") # for est.transdist -importFrom("spatstat", "as.ppp") # for est.transdist -importFrom("spatstat", "ppp") # for est.transdist -importFrom("spatstat", "crossdist") # for est.transdist -importFrom("spatstat", "Kcross") # for get.cross.K -importFrom("spatstat", "pcf") # for get.cross.PCF +importFrom("igraph", "graph.data.frame") # for get.transdist.theta() +importFrom("igraph", "shortest.paths") # for get.transdist.theta() +importFrom("igraph", "E") # for get.transdist.theta() +importFrom("spatstat", "bounding.box.xy") # for est.transdist() +importFrom("spatstat", "as.ppp") # for est.transdist() +importFrom("spatstat", "ppp") # for est.transdist() +importFrom("spatstat", "crossdist") # for est.transdist() +importFrom("spatstat", "Kcross") # for get.cross.K() +importFrom("spatstat", "pcf") # for get.cross.PCF() export(get.pi) export(get.pi.ci) export(get.pi.bootstrap) @@ -45,5 +45,4 @@ export(est.transdist.temporal) export(est.transdist.temporal.bootstrap.ci) export(get.cross.K) export(get.cross.PCF) -useDynLib(IDSpatialStats, .registration=TRUE, .fixes="C_") - +useDynLib(IDSpatialStats, .registration=TRUE, .fixes="C_") \ No newline at end of file From b8407f9b136c68d7d5f0a4d4465932935bce0f0b Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sat, 8 Feb 2020 18:21:21 +0000 Subject: [PATCH 06/70] Add citations. --- inst/CITATION | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 inst/CITATION diff --git a/inst/CITATION b/inst/CITATION new file mode 100644 index 0000000..985cfaa --- /dev/null +++ b/inst/CITATION @@ -0,0 +1,60 @@ +bibentry( + header = "To cite IDSpatialStats in publications please use:", + key = "Giles2019", + bibtype = "Unpublished", + title = "The IDSpatialStats R Package: Quantifying Spatial Dependence + of Infectious Disease Spread", + author = c(as.person("John R. Giles"),as.person("Henrik Salje"),as.person("Justin Lessler")), + year = 2019, + doi = "10.32614/RJ-2019-043", + journal = "The R Journal", + url = "https://journal.r-project.org/archive/2019/RJ-2019-043/index.html", + note = "Accepted article", +) + +bibentry( + header = "If you calculate mean transmission distances using IDSpatialStats please also cite:", + key = "Salje2016", + bibtype = "Article", + title = "Estimating infectious disease transmission distances using the overall distribution of cases", + author = c(as.person("Henrik Salje"),as.person("Derek A.T. Cummings"),as.person("Justin Lessler")), + year = 2016, + doi = "10.1016/j.epidem.2016.10.001", + journal = "Epidemics", + url = "https://www.sciencedirect.com/science/article/pii/S1755436516300317" +) + +c(bibentry( + header = "For the two foundational papers responsible for the tau statistic please also cite:", + key = "Salje2012", + bibtype = "Article", + title = "Revealing the microscale spatial signature of dengue transmission and immunity in an urban population", + author = c(as.person("Henrik Salje"),as.person("Justin Lessler"),as.person("Timothy P. Endy"),as.person("Frank C. Curriero"),as.person("Robert V. Gibbons"),as.person("Ananda Nisalak"),as.person("Suchitra Nimmannitya"),as.person("Siripen Kalayanarooj"),as.person("Richard G. Jarman"),as.person("Stephen J. Thomas"),as.person("Donald S. Burke"),as.person("Derek A. T. Cummings")), + year = 2012, + doi = "doi.org/10.1073/pnas.1120621109", + journal = "PNAS", + url = "https://www.pnas.org/content/109/24/9535" + ), + bibentry( + key = "Lessler2016", + bibtype = "Article", + title = "Measuring Spatial Dependence for Infectious Disease Epidemiology", + author = c(as.person("Justin Lessler"),as.person("Henrik Salje"),as.person("M. Kate Grabowski"),as.person("Derek A. T. Cummings")), + year = 2016, + doi = "10.1371/journal.pone.0155249", + journal = "PLoS ONE", + url = "https://journals.plos.org/plosone/article?id=10.1371/journal.pone.0155249" + ) +) + +bibentry( + header = "For the method and rationale of graphical hypothesis testing for the tau statistic please also cite:", + key = "Pollington2019", + bibtype = "Unpublished", + title = "Measuring spatiotemporal disease clustering with the tau statistic", + author = c(as.person("Timothy M. Pollington"),as.person("Michael J. Tildesley"),as.person("T. Déirdre Hollingsworth"),as.person("Lloyd A. C. Chapman")), + year = 2019, + journal = "arXiv", + url = "https://arxiv.org/abs/1911.08022", + note = "Under review" +) \ No newline at end of file From b879d98b00eae36889d327425e02b86f9324b810 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sat, 8 Feb 2020 20:09:49 +0000 Subject: [PATCH 07/70] Add NEWS. Update version no in DESCRIPTION as major version occurring. --- DESCRIPTION | 3 ++- NEWS.md | 8 ++++++++ 2 files changed, 10 insertions(+), 1 deletion(-) create mode 100644 NEWS.md diff --git a/DESCRIPTION b/DESCRIPTION index 6679659..ec90f8b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: IDSpatialStats -Version: 0.4.0 +Version: 1.0.0 Date: 2020-02-06 Title: Estimate Global Clustering in Infectious Disease Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9741-8109", "Co-creator & maintainer"), @@ -20,4 +20,5 @@ Imports: igraph, spatstat Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr +URL: https://github.com/HopkinsIDD/IDSpatialStats BugReports: https://github.com/HopkinsIDD/IDSpatialStats/issues \ No newline at end of file diff --git a/NEWS.md b/NEWS.md new file mode 100644 index 0000000..1dd7d30 --- /dev/null +++ b/NEWS.md @@ -0,0 +1,8 @@ +# IDSpatialStats 0.4.0 + +## Changes (top of list are most important) +* NEWS.md file added +* CITATION file added +* README.md formatting updated + +## Bug fixes (top of list are most important) From e7c5c9cd4be74606e7fc90e064abf4862e4dd6f2 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 12 Feb 2020 08:35:29 +0000 Subject: [PATCH 08/70] Remove dupl words. Add code{fun} --- R/spatialfuncs.r | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 6b830ca..7a47eb1 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -4,7 +4,7 @@ ##' returns the probability that a point within a particular range of a point of interest shares the relationship ##' specified by the passed in function with that point. ##' -##' @param posmat a matrix with columns x, y and any other named columns +##' @param posmat a matrix with columns x, y and any other named ##' columns needed by \code{fun} ##' @param fun a function that takes in two rows of \code{posmat} and returns: ##' \enumerate{ @@ -70,8 +70,8 @@ get.pi <- function(posmat, ##' returns the odds that a point within a particular range of a point of interest shares the relationship ##' specified by the passed in function with that point. ##' -##' @param posmat a matrix with columns x, y and any other named columns -##' columns needed by fun +##' @param posmat a matrix with columns x, y and any other named +##' columns needed by \code{fun} ##' @param fun a function that takes in two rows of posmat and returns: ##' \enumerate{ ##' \item for pairs that are (potentially) related @@ -825,8 +825,8 @@ get.theta.typed.permute <- function(posmat, ##' from an index point share some relationship with that point versus ##' the probability (or odds) any point shares that relationship with that point. ##' -##' @param posmat a matrix with columns x, y and any other named columns -##' columns needed by fun +##' @param posmat a matrix with columns x, y and any other named +##' columns needed by \code{fun} ##' @param fun a function that takes in two rows of posmat and returns: ##' \enumerate{ ##' \item for pairs included in the numerator (and the denominator for independent data) From 1c861d4a8b2eda8b4d4ee1b1e31a1a77960579ee Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 12 Feb 2020 17:10:56 +0000 Subject: [PATCH 09/70] Update get.pi.ci documentation and example. --- .Rbuildignore | 2 + .gitignore | 7 ++ DESCRIPTION | 4 +- IDSpatialStats.Rproj | 17 ++++ R/examples/get_pi_ci.R | 41 +++++---- R/spatialfuncs.r | 37 ++++---- man/est.transdist.Rd | 28 ++++-- man/est.transdist.bootstrap.ci.Rd | 31 +++++-- man/est.transdist.temporal.Rd | 27 ++++-- man/est.transdist.temporal.bootstrap.ci.Rd | 31 +++++-- man/est.transdist.theta.weights.Rd | 14 +-- man/est.wt.matrix.Rd | 5 +- man/est.wt.matrix.weights.Rd | 5 +- man/get.cross.K.Rd | 3 +- man/get.cross.PCF.Rd | 3 +- man/get.pi.Rd | 22 +++-- man/get.pi.bootstrap.Rd | 22 +++-- man/get.pi.ci.Rd | 101 ++++++++++++--------- man/get.pi.permute.Rd | 22 +++-- man/get.pi.typed.Rd | 21 +++-- man/get.pi.typed.bootstrap.Rd | 22 +++-- man/get.pi.typed.permute.Rd | 22 +++-- man/get.tau.Rd | 33 ++++--- man/get.tau.bootstrap.Rd | 23 +++-- man/get.tau.ci.Rd | 28 ++++-- man/get.tau.permute.Rd | 23 +++-- man/get.tau.typed.Rd | 23 +++-- man/get.tau.typed.bootstrap.Rd | 24 +++-- man/get.tau.typed.permute.Rd | 24 +++-- man/get.theta.Rd | 25 ++--- man/get.theta.bootstrap.Rd | 22 +++-- man/get.theta.ci.Rd | 25 +++-- man/get.theta.permute.Rd | 22 +++-- man/get.theta.typed.Rd | 23 +++-- man/get.theta.typed.bootstrap.Rd | 23 +++-- man/get.theta.typed.permute.Rd | 23 +++-- man/get.transdist.theta.Rd | 20 ++-- man/sim.epidemic.Rd | 11 ++- 38 files changed, 567 insertions(+), 292 deletions(-) create mode 100644 .Rbuildignore create mode 100644 .gitignore create mode 100644 IDSpatialStats.Rproj diff --git a/.Rbuildignore b/.Rbuildignore new file mode 100644 index 0000000..91114bf --- /dev/null +++ b/.Rbuildignore @@ -0,0 +1,2 @@ +^.*\.Rproj$ +^\.Rproj\.user$ diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..56843bc --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +.Rproj.user +.Rhistory +.RData +.Ruserdata +src/*.o +src/*.so +src/*.dll diff --git a/DESCRIPTION b/DESCRIPTION index ec90f8b..fdf57ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -14,11 +14,11 @@ License: GPL (>=2) Description: Implements various novel and standard clustering statistics and other analyses useful for understanding the spread of infectious disease. -RoxygenNote: 6.1.1 +RoxygenNote: 7.0.2 Encoding: UTF-8 Imports: igraph, spatstat Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr URL: https://github.com/HopkinsIDD/IDSpatialStats -BugReports: https://github.com/HopkinsIDD/IDSpatialStats/issues \ No newline at end of file +BugReports: https://github.com/HopkinsIDD/IDSpatialStats/issues diff --git a/IDSpatialStats.Rproj b/IDSpatialStats.Rproj new file mode 100644 index 0000000..c52d81d --- /dev/null +++ b/IDSpatialStats.Rproj @@ -0,0 +1,17 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 1 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX + +BuildType: Package +PackageUseDevtools: Yes +PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/R/examples/get_pi_ci.R b/R/examples/get_pi_ci.R index 59c2e0d..cf1aea9 100644 --- a/R/examples/get_pi_ci.R +++ b/R/examples/get_pi_ci.R @@ -1,26 +1,27 @@ -\donttest{ +\donttest{# Simulate cases (type = 2, Normally-distributed points) and +# simulated non-cases (type = 1, Uniformally-distributed) +X <- cbind(1, runif(100,-100,100), runif(100,-100,100)) +X <- rbind(X, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) +colnames(X) <- c("type","x","y") -#compare normally distributed with uniform points -x<-cbind(1,runif(100,-100,100), runif(100,-100,100)) -x<-rbind(x, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) -colnames(x) <- c("type","x","y") - -fun<-function(a,b) { - if(a[1]!=2) return(3) - if (b[1]==2) return(1) - return(2) +fun <- function(a,b) { + # possible 'ab' pair types {'11'; '12'; '21'; '22'} + if(a[1]!=2) return(3) # it's {'11' or '12'} so ignore + if(b[1]==2) return(1) # it's '22' so count as a case-case pair in numerator and denominator + # else it's a '21' ie a case-non-case pair + return(2) # so count in denominator } -r.max<-seq(10,100,10) -r.min<-seq(0,90,10) -r.mid <- (r.max+r.min)/2 - +# define distance band set +r.max <- seq(10,100,10) +r.min <- seq(0,90,10) +r.mid <- (r.max + r.min)/2 -pi<-get.pi(x,fun,r=r.max,r.low=r.min) -pi.ci<-get.pi.ci(x,fun,r=r.max,r.low=r.min,boot.iter=100) +# compute the pi point estimate and its 95% BCa CI +pi <- get.pi(X, fun, r=r.max, r.low = r.min) +pi.ci <- get.pi.ci(X, fun, r = r.max, r.low = r.min, boot.iter = 100) +# plot the pi point estimate with its CI, at the midpoints of each distance band plot(r.mid, pi$pi, type="l") -lines(r.mid, pi.ci[,2] , lty=2) -lines(r.mid, pi.ci[,3] , lty=2) - -} \ No newline at end of file +lines(r.mid, pi.ci$ci.low, lty=2) +lines(r.mid, pi.ci$ci.high, lty=2)} \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 7a47eb1..4248228 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -230,30 +230,35 @@ get.theta.typed <- function(posmat, } -##' Calculate bootstrapped confidence intervals for \code{get.pi} values. +##' Calculate bootstrapped BCa confidence intervals from \code{get.pi} values. ##' -##' Wrapper to \code{get.pi.bootstrap} that takes care of calculating the -##' confidence intervals based on the bootstrapped values.. +##' Wrapper using \pkg{coxed} package to calculate the +##' BCa (bias-corrected and accelerated) confidence interval (CI) for \eqn{\pi}(\code{r.low}, \code{r}), based on bootstrapped values from \code{get.pi.bootstrap}. ##' +##' @param posmat a matrix with named columns x and y for 2D individual location +##' @param fun the function to decide transmission-related pairs +##' @param r the upper end of each distance band +##' @param r.low the low end of each distance band (default: a vector of zeroes) +##' @param boot.iter the number of bootstrap iterations (default = 1000) +##' @param ci.low the low end of the BCa CI (default = 0.025) +##' @param ci.high the high end of the BCa CI (default = 0.975) +##' @param data.frame logical: indicating whether to return results as a data frame (default = TRUE) ##' -##' @param posmat a matrix with columns type, x and y -##' @param fun the function to decide relationships -##' @param r the series of spatial distances wer are interested in -##' @param r.low the low end of each range. 0 by default -##' @param boot.iter the number of bootstrap iterations -##' @param ci.low the low end of the ci...0.025 by default -##' @param ci.high the high end of the ci...0.975 by default -##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) +##' @return If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. ##' -##' @return a matrix with a row for the high and low values and -##' a column per distance +##' @author Justin Lessler and Timothy M Pollington ##' -##' @author Justin Lessler +##' @references \href{https://arxiv.org/pdf/1911.08022.pdf#page=18}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2019) +##' Measuring spatiotemporal disease clustering with the tau statistic. +##' *arXiv/stat.ME: 1911.08022v3*. ##' ##' @family get.pi +##' +##' @section Depends on: +##' coxed::bca() ##' ##' @example R/examples/get_pi_ci.R -##' +##' @md get.pi.ci <- function(posmat, fun, @@ -970,7 +975,7 @@ get.tau.typed <- function(posmat, ##' Bootstrap confidence interval for the \code{get.tau} values ##' ##' Wrapper to \code{get.tau.bootstrap} that takes care of calulating -##' the confidence intervals based on the bootstrapped values +##' the confidence intervals based on the bootstrapped values. ##' ##' @param posmat a matrix appropriate for input to \code{get.tau} ##' @param fun a function appropriate as input to \code{get.pi} diff --git a/man/est.transdist.Rd b/man/est.transdist.Rd index e9a5654..31b346e 100644 --- a/man/est.transdist.Rd +++ b/man/est.transdist.Rd @@ -4,8 +4,16 @@ \alias{est.transdist} \title{Estimate transmission distance} \usage{ -est.transdist(epi.data, gen.t.mean, gen.t.sd, t1, max.sep, max.dist, - n.transtree.reps = 100, theta.weights = NULL) +est.transdist( + epi.data, + gen.t.mean, + gen.t.sd, + t1, + max.sep, + max.dist, + n.transtree.reps = 100, + theta.weights = NULL +) } \arguments{ \item{epi.data}{a three-column matrix giving the coordinates (\code{x} and \code{y}) and time of infection (\code{t} for all cases in an epidemic (columns must be in \code{x}, \code{y}, \code{t} order)} @@ -62,14 +70,16 @@ b Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other est.wt: \code{\link{est.wt.matrix.weights}}, - \code{\link{est.wt.matrix}} +Other est.wt: +\code{\link{est.wt.matrix.weights}()}, +\code{\link{est.wt.matrix}()} -Other transdist: \code{\link{est.transdist.bootstrap.ci}}, - \code{\link{est.transdist.temporal.bootstrap.ci}}, - \code{\link{est.transdist.temporal}}, - \code{\link{est.transdist.theta.weights}}, - \code{\link{get.transdist.theta}} +Other transdist: +\code{\link{est.transdist.bootstrap.ci}()}, +\code{\link{est.transdist.temporal.bootstrap.ci}()}, +\code{\link{est.transdist.temporal}()}, +\code{\link{est.transdist.theta.weights}()}, +\code{\link{get.transdist.theta}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.transdist.bootstrap.ci.Rd b/man/est.transdist.bootstrap.ci.Rd index 786bb09..b782570 100644 --- a/man/est.transdist.bootstrap.ci.Rd +++ b/man/est.transdist.bootstrap.ci.Rd @@ -4,10 +4,22 @@ \alias{est.transdist.bootstrap.ci} \title{Bootstrap mean transmission distance values} \usage{ -est.transdist.bootstrap.ci(epi.data, gen.t.mean, gen.t.sd, t1, max.sep, - max.dist, n.transtree.reps = 100, mean.equals.sd = FALSE, - theta.weights = NULL, boot.iter, ci.low = 0.025, ci.high = 0.975, - parallel = FALSE, n.cores = NULL) +est.transdist.bootstrap.ci( + epi.data, + gen.t.mean, + gen.t.sd, + t1, + max.sep, + max.dist, + n.transtree.reps = 100, + mean.equals.sd = FALSE, + theta.weights = NULL, + boot.iter, + ci.low = 0.025, + ci.high = 0.975, + parallel = FALSE, + n.cores = NULL +) } \arguments{ \item{epi.data}{a three-column matrix giving the coordinates (\code{x} and \code{y}) and time of infection (\code{t} for all cases in an epidemic (columns must be in \code{x}, \code{y}, \code{t} order)} @@ -81,11 +93,12 @@ b Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other transdist: \code{\link{est.transdist.temporal.bootstrap.ci}}, - \code{\link{est.transdist.temporal}}, - \code{\link{est.transdist.theta.weights}}, - \code{\link{est.transdist}}, - \code{\link{get.transdist.theta}} +Other transdist: +\code{\link{est.transdist.temporal.bootstrap.ci}()}, +\code{\link{est.transdist.temporal}()}, +\code{\link{est.transdist.theta.weights}()}, +\code{\link{est.transdist}()}, +\code{\link{get.transdist.theta}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.transdist.temporal.Rd b/man/est.transdist.temporal.Rd index f3e931e..089830f 100644 --- a/man/est.transdist.temporal.Rd +++ b/man/est.transdist.temporal.Rd @@ -4,9 +4,19 @@ \alias{est.transdist.temporal} \title{Change in mean transmission distance over time} \usage{ -est.transdist.temporal(epi.data, gen.t.mean, gen.t.sd, t1, max.sep, - max.dist, n.transtree.reps = 10, mean.equals.sd = FALSE, - theta.weights = NULL, parallel = FALSE, n.cores = NULL) +est.transdist.temporal( + epi.data, + gen.t.mean, + gen.t.sd, + t1, + max.sep, + max.dist, + n.transtree.reps = 10, + mean.equals.sd = FALSE, + theta.weights = NULL, + parallel = FALSE, + n.cores = NULL +) } \arguments{ \item{epi.data}{a three-column matrix giving the coordinates (\code{x} and \code{y}) and time of infection (\code{t} for all cases in an epidemic (columns must be in \code{x}, \code{y}, \code{t} order)} @@ -84,11 +94,12 @@ lines(low, lwd=3, col='blue') Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other transdist: \code{\link{est.transdist.bootstrap.ci}}, - \code{\link{est.transdist.temporal.bootstrap.ci}}, - \code{\link{est.transdist.theta.weights}}, - \code{\link{est.transdist}}, - \code{\link{get.transdist.theta}} +Other transdist: +\code{\link{est.transdist.bootstrap.ci}()}, +\code{\link{est.transdist.temporal.bootstrap.ci}()}, +\code{\link{est.transdist.theta.weights}()}, +\code{\link{est.transdist}()}, +\code{\link{get.transdist.theta}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.transdist.temporal.bootstrap.ci.Rd b/man/est.transdist.temporal.bootstrap.ci.Rd index 9917d23..f7ef611 100644 --- a/man/est.transdist.temporal.bootstrap.ci.Rd +++ b/man/est.transdist.temporal.bootstrap.ci.Rd @@ -4,10 +4,22 @@ \alias{est.transdist.temporal.bootstrap.ci} \title{Bootstrapped confidence intervals for the change in mean transmission distance over time} \usage{ -est.transdist.temporal.bootstrap.ci(epi.data, gen.t.mean, gen.t.sd, t1, - max.sep, max.dist, n.transtree.reps = 100, mean.equals.sd = FALSE, - theta.weights = NULL, boot.iter, ci.low = 0.025, ci.high = 0.975, - parallel = FALSE, n.cores = NULL) +est.transdist.temporal.bootstrap.ci( + epi.data, + gen.t.mean, + gen.t.sd, + t1, + max.sep, + max.dist, + n.transtree.reps = 100, + mean.equals.sd = FALSE, + theta.weights = NULL, + boot.iter, + ci.low = 0.025, + ci.high = 0.975, + parallel = FALSE, + n.cores = NULL +) } \arguments{ \item{epi.data}{a three-column matrix giving the coordinates (\code{x} and \code{y}) and time of infection (\code{t} for all cases in an epidemic (columns must be in \code{x}, \code{y}, \code{t} order)} @@ -101,11 +113,12 @@ for(i in 3:4) { Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other transdist: \code{\link{est.transdist.bootstrap.ci}}, - \code{\link{est.transdist.temporal}}, - \code{\link{est.transdist.theta.weights}}, - \code{\link{est.transdist}}, - \code{\link{get.transdist.theta}} +Other transdist: +\code{\link{est.transdist.bootstrap.ci}()}, +\code{\link{est.transdist.temporal}()}, +\code{\link{est.transdist.theta.weights}()}, +\code{\link{est.transdist}()}, +\code{\link{get.transdist.theta}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.transdist.theta.weights.Rd b/man/est.transdist.theta.weights.Rd index ab7e281..4d94a49 100644 --- a/man/est.transdist.theta.weights.Rd +++ b/man/est.transdist.theta.weights.Rd @@ -4,8 +4,7 @@ \alias{est.transdist.theta.weights} \title{Estimate transmission distance theta values by replication} \usage{ -est.transdist.theta.weights(case.times, gen.t.mean, t.density, t1, - n.rep = 100) +est.transdist.theta.weights(case.times, gen.t.mean, t.density, t1, n.rep = 100) } \arguments{ \item{case.times}{a vector giving the occurrence time for each case} @@ -72,11 +71,12 @@ b <- est.transdist.theta.weights(case.times=case.times, Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other transdist: \code{\link{est.transdist.bootstrap.ci}}, - \code{\link{est.transdist.temporal.bootstrap.ci}}, - \code{\link{est.transdist.temporal}}, - \code{\link{est.transdist}}, - \code{\link{get.transdist.theta}} +Other transdist: +\code{\link{est.transdist.bootstrap.ci}()}, +\code{\link{est.transdist.temporal.bootstrap.ci}()}, +\code{\link{est.transdist.temporal}()}, +\code{\link{est.transdist}()}, +\code{\link{get.transdist.theta}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.wt.matrix.Rd b/man/est.wt.matrix.Rd index a8734d9..f51c845 100644 --- a/man/est.wt.matrix.Rd +++ b/man/est.wt.matrix.Rd @@ -37,8 +37,9 @@ a <- est.wt.matrix(case.times=case.times, gen.t.dist=t.density) Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other est.wt: \code{\link{est.transdist}}, - \code{\link{est.wt.matrix.weights}} +Other est.wt: +\code{\link{est.transdist}()}, +\code{\link{est.wt.matrix.weights}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/est.wt.matrix.weights.Rd b/man/est.wt.matrix.weights.Rd index 78dc4bd..cbd145f 100644 --- a/man/est.wt.matrix.weights.Rd +++ b/man/est.wt.matrix.weights.Rd @@ -35,8 +35,9 @@ Boelle P and Obadia T (2015). R0: Estimation of R0 and Real-Time Reproduction Nu Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other est.wt: \code{\link{est.transdist}}, - \code{\link{est.wt.matrix}} +Other est.wt: +\code{\link{est.transdist}()}, +\code{\link{est.wt.matrix}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/get.cross.K.Rd b/man/get.cross.K.Rd index 4bd96b3..a9eef05 100644 --- a/man/get.cross.K.Rd +++ b/man/get.cross.K.Rd @@ -4,8 +4,7 @@ \alias{get.cross.K} \title{Cross type K function using homotypic and heterotypic case types} \usage{ -get.cross.K(epi.data, type, hom, het = NULL, r = NULL, - correction = "border") +get.cross.K(epi.data, type, hom, het = NULL, r = NULL, correction = "border") } \arguments{ \item{epi.data}{a three-column numerical matrix that contains coordinates (\code{x} and \code{y}) for each case and information on case type (e.g. genotype or serotype). First two columns must be \code{x} and \code{y}} diff --git a/man/get.cross.PCF.Rd b/man/get.cross.PCF.Rd index bfba949..e424906 100644 --- a/man/get.cross.PCF.Rd +++ b/man/get.cross.PCF.Rd @@ -4,8 +4,7 @@ \alias{get.cross.PCF} \title{Cross type Pair Correlation Function using homotypic and heterotypic case types} \usage{ -get.cross.PCF(epi.data, type, hom, het = NULL, r = NULL, - correction = "border") +get.cross.PCF(epi.data, type, hom, het = NULL, r = NULL, correction = "border") } \arguments{ \item{epi.data}{a three-column numerical matrix that contains coordinates (\code{x} and \code{y}) for each case and information on case type (e.g. genotype or serotype). First two columns must be \code{x} and \code{y}} diff --git a/man/get.pi.Rd b/man/get.pi.Rd index de6dbc0..e02646d 100644 --- a/man/get.pi.Rd +++ b/man/get.pi.Rd @@ -4,11 +4,10 @@ \alias{get.pi} \title{Generalized version of \code{get.pi}} \usage{ -get.pi(posmat, fun, r = 1, r.low = rep(0, length(r)), - data.frame = TRUE) +get.pi(posmat, fun, r = 1, r.low = rep(0, length(r)), data.frame = TRUE) } \arguments{ -\item{posmat}{a matrix with columns x, y and any other named columns +\item{posmat}{a matrix with columns x, y and any other named columns needed by \code{fun}} \item{fun}{a function that takes in two rows of \code{posmat} and returns: @@ -56,14 +55,17 @@ sero.pi<-get.pi(DengueSimR02,sero.type.func,r=r.max,r.low=r.min) } } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.ci}}, \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed.permute}}, - \code{\link{get.pi.typed}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi.typed}()} -Other spatialtau: \code{\link{get.tau}}, - \code{\link{get.theta}} +Other spatialtau: +\code{\link{get.tau}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.pi.bootstrap.Rd b/man/get.pi.bootstrap.Rd index 170dd04..5beab5d 100644 --- a/man/get.pi.bootstrap.Rd +++ b/man/get.pi.bootstrap.Rd @@ -4,8 +4,14 @@ \alias{get.pi.bootstrap} \title{Bootstrap \code{get.pi} values.} \usage{ -get.pi.bootstrap(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter = 500, data.frame = TRUE) +get.pi.bootstrap( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 500, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -64,11 +70,13 @@ lines(r.mid, pi.ci[2,] , lty=2) } } \seealso{ -Other get.pi: \code{\link{get.pi.ci}}, - \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed.permute}}, - \code{\link{get.pi.typed}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi.typed}()}, +\code{\link{get.pi}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.pi.ci.Rd b/man/get.pi.ci.Rd index 4662900..098fc39 100644 --- a/man/get.pi.ci.Rd +++ b/man/get.pi.ci.Rd @@ -2,73 +2,92 @@ % Please edit documentation in R/spatialfuncs.r \name{get.pi.ci} \alias{get.pi.ci} -\title{Calculate bootstrapped confidence intervals for \code{get.pi} values.} +\title{Calculate bootstrapped BCa confidence intervals from \code{get.pi} values.} \usage{ -get.pi.ci(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter = 1000, ci.low = 0.025, ci.high = 0.975, - data.frame = TRUE) +get.pi.ci( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 1000, + ci.low = 0.025, + ci.high = 0.975, + data.frame = TRUE +) } \arguments{ -\item{posmat}{a matrix with columns type, x and y} +\item{posmat}{a matrix with named columns x and y for 2D individual location} -\item{fun}{the function to decide relationships} +\item{fun}{the function to decide transmission-related pairs} -\item{r}{the series of spatial distances wer are interested in} +\item{r}{the upper end of each distance band} -\item{r.low}{the low end of each range. 0 by default} +\item{r.low}{the low end of each distance band (default: a vector of zeroes)} -\item{boot.iter}{the number of bootstrap iterations} +\item{boot.iter}{the number of bootstrap iterations (default = 1000)} -\item{ci.low}{the low end of the ci...0.025 by default} +\item{ci.low}{the low end of the BCa CI (default = 0.025)} -\item{ci.high}{the high end of the ci...0.975 by default} +\item{ci.high}{the high end of the BCa CI (default = 0.975)} -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} +\item{data.frame}{logical: indicating whether to return results as a data frame (default = TRUE)} } \value{ -a matrix with a row for the high and low values and - a column per distance +If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. } \description{ -Wrapper to \code{get.pi.bootstrap} that takes care of calculating the -confidence intervals based on the bootstrapped values.. +Wrapper using \pkg{coxed} package to calculate the +BCa (bias-corrected and accelerated) confidence interval (CI) for \eqn{\pi}(\code{r.low}, \code{r}), based on bootstrapped values from \code{get.pi.bootstrap}. } -\examples{ -\donttest{ - -#compare normally distributed with uniform points -x<-cbind(1,runif(100,-100,100), runif(100,-100,100)) -x<-rbind(x, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) -colnames(x) <- c("type","x","y") +\section{Depends on}{ -fun<-function(a,b) { - if(a[1]!=2) return(3) - if (b[1]==2) return(1) - return(2) +coxed::bca() } -r.max<-seq(10,100,10) -r.min<-seq(0,90,10) -r.mid <- (r.max+r.min)/2 +\examples{ +\donttest{# Simulate cases (type = 2, Normally-distributed points) and +# simulated non-cases (type = 1, Uniformally-distributed) +X <- cbind(1, runif(100,-100,100), runif(100,-100,100)) +X <- rbind(X, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) +colnames(X) <- c("type","x","y") + +fun <- function(a,b) { + # possible 'ab' pair types {'11'; '12'; '21'; '22'} + if(a[1]!=2) return(3) # it's {'11' or '12'} so ignore + if(b[1]==2) return(1) # it's '22' so count as a case-case pair in numerator and denominator + # else it's a '21' ie a case-non-case pair + return(2) # so count in denominator +} +# define distance band set +r.max <- seq(10,100,10) +r.min <- seq(0,90,10) +r.mid <- (r.max + r.min)/2 -pi<-get.pi(x,fun,r=r.max,r.low=r.min) -pi.ci<-get.pi.ci(x,fun,r=r.max,r.low=r.min,boot.iter=100) +# compute the pi point estimate and its 95\% BCa CI +pi <- get.pi(X, fun, r=r.max, r.low = r.min) +pi.ci <- get.pi.ci(X, fun, r = r.max, r.low = r.min, boot.iter = 100) +# plot the pi point estimate with its CI, at the midpoints of each distance band plot(r.mid, pi$pi, type="l") -lines(r.mid, pi.ci[,2] , lty=2) -lines(r.mid, pi.ci[,3] , lty=2) - +lines(r.mid, pi.ci$ci.low, lty=2) +lines(r.mid, pi.ci$ci.high, lty=2)} } +\references{ +\href{https://arxiv.org/pdf/1911.08022.pdf#page=18}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2019) +Measuring spatiotemporal disease clustering with the tau statistic. +\emph{arXiv/stat.ME: 1911.08022v3}. } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed.permute}}, - \code{\link{get.pi.typed}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi.typed}()}, +\code{\link{get.pi}()} } \author{ -Justin Lessler +Justin Lessler and Timothy M Pollington } \concept{get.pi} diff --git a/man/get.pi.permute.Rd b/man/get.pi.permute.Rd index 3fef8cc..4006c10 100644 --- a/man/get.pi.permute.Rd +++ b/man/get.pi.permute.Rd @@ -4,8 +4,14 @@ \alias{get.pi.permute} \title{get the null distribution of the \code{get.pi} function} \usage{ -get.pi.permute(posmat, fun, r = 1, r.low = rep(0, length(r)), - permutations, data.frame = TRUE) +get.pi.permute( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + permutations, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -58,10 +64,12 @@ lines(r.mid, null.ci[2,] , lty=2) } } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.ci}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed.permute}}, - \code{\link{get.pi.typed}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi.typed}()}, +\code{\link{get.pi}()} } \concept{get.pi} diff --git a/man/get.pi.typed.Rd b/man/get.pi.typed.Rd index a5acf4f..cca1a53 100644 --- a/man/get.pi.typed.Rd +++ b/man/get.pi.typed.Rd @@ -4,8 +4,14 @@ \alias{get.pi.typed} \title{Optimized version of \code{get.pi} for typed data.} \usage{ -get.pi.typed(posmat, typeA = -1, typeB = -1, r = 1, r.low = rep(0, - length(r)), data.frame = TRUE) +get.pi.typed( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -45,10 +51,13 @@ typed.pi<-get.pi.typed(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min) } } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.ci}}, \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed.permute}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.pi.typed.bootstrap.Rd b/man/get.pi.typed.bootstrap.Rd index 3a7f3fe..f6a15ef 100644 --- a/man/get.pi.typed.bootstrap.Rd +++ b/man/get.pi.typed.bootstrap.Rd @@ -4,8 +4,15 @@ \alias{get.pi.typed.bootstrap} \title{runs bootstrapping on \code{get.pi.typed}} \usage{ -get.pi.typed.bootstrap(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), boot.iter, data.frame = TRUE) +get.pi.typed.bootstrap( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + boot.iter, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -46,9 +53,12 @@ typed.pi.bs<-get.pi.typed.bootstrap(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min,boot } } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.ci}}, \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.permute}}, - \code{\link{get.pi.typed}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.permute}()}, +\code{\link{get.pi.typed}()}, +\code{\link{get.pi}()} } \concept{get.pi} diff --git a/man/get.pi.typed.permute.Rd b/man/get.pi.typed.permute.Rd index eed0f5e..4117f02 100644 --- a/man/get.pi.typed.permute.Rd +++ b/man/get.pi.typed.permute.Rd @@ -4,8 +4,15 @@ \alias{get.pi.typed.permute} \title{get the null distribution of the get.pi.typed function} \usage{ -get.pi.typed.permute(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), permutations, data.frame = TRUE) +get.pi.typed.permute( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + permutations, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -48,10 +55,13 @@ typed.pi.type.null<-get.pi.typed.permute(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min } } \seealso{ -Other get.pi: \code{\link{get.pi.bootstrap}}, - \code{\link{get.pi.ci}}, \code{\link{get.pi.permute}}, - \code{\link{get.pi.typed.bootstrap}}, - \code{\link{get.pi.typed}}, \code{\link{get.pi}} +Other get.pi: +\code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, +\code{\link{get.pi.permute}()}, +\code{\link{get.pi.typed.bootstrap}()}, +\code{\link{get.pi.typed}()}, +\code{\link{get.pi}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.Rd b/man/get.tau.Rd index 0ca43f4..1371186 100644 --- a/man/get.tau.Rd +++ b/man/get.tau.Rd @@ -4,12 +4,18 @@ \alias{get.tau} \title{generalized version of \code{get.tau}} \usage{ -get.tau(posmat, fun, r = 1, r.low = rep(0, length(r)), - comparison.type = "representative", data.frame = TRUE) +get.tau( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ -\item{posmat}{a matrix with columns x, y and any other named columns -columns needed by fun} +\item{posmat}{a matrix with columns x, y and any other named +columns needed by \code{fun}} \item{fun}{a function that takes in two rows of posmat and returns: \enumerate{ @@ -122,14 +128,17 @@ legend("topright", } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.ci}}, \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau.typed}} - -Other spatialtau: \code{\link{get.pi}}, - \code{\link{get.theta}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()} + +Other spatialtau: +\code{\link{get.pi}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.bootstrap.Rd b/man/get.tau.bootstrap.Rd index 8500992..f0f77a4 100644 --- a/man/get.tau.bootstrap.Rd +++ b/man/get.tau.bootstrap.Rd @@ -4,8 +4,15 @@ \alias{get.tau.bootstrap} \title{Bootstrap \code{get.tau} values.} \usage{ -get.tau.bootstrap(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter, comparison.type = "representative", data.frame = TRUE) +get.tau.bootstrap( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter, + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix appropriate for input to \code{get.tau}} @@ -61,11 +68,13 @@ lines(r.mid, tau.ci[2,] , lty=2) } } \seealso{ -Other get.tau: \code{\link{get.tau.ci}}, - \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau.typed}}, \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.ci.Rd b/man/get.tau.ci.Rd index decba6e..264f9d8 100644 --- a/man/get.tau.ci.Rd +++ b/man/get.tau.ci.Rd @@ -4,9 +4,17 @@ \alias{get.tau.ci} \title{Bootstrap confidence interval for the \code{get.tau} values} \usage{ -get.tau.ci(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter = 1000, comparison.type = "representative", - ci.low = 0.025, ci.high = 0.975, data.frame = TRUE) +get.tau.ci( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 1000, + comparison.type = "representative", + ci.low = 0.025, + ci.high = 0.975, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix appropriate for input to \code{get.tau}} @@ -32,7 +40,7 @@ a data frame with the point estimate of tau and its low and high confidence inte } \description{ Wrapper to \code{get.tau.bootstrap} that takes care of calulating -the confidence intervals based on the bootstrapped values +the confidence intervals based on the bootstrapped values. } \examples{ \donttest{ @@ -63,11 +71,13 @@ lines(c(0,100),c(1,1), lty=3, col="grey") } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau.typed}}, \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.permute.Rd b/man/get.tau.permute.Rd index 170f116..321cfac 100644 --- a/man/get.tau.permute.Rd +++ b/man/get.tau.permute.Rd @@ -4,8 +4,15 @@ \alias{get.tau.permute} \title{get the null distribution of the \code{get.tau} function} \usage{ -get.tau.permute(posmat, fun, r = 1, r.low = rep(0, length(r)), - permutations, comparison.type = "representative", data.frame = TRUE) +get.tau.permute( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + permutations, + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix appropriate for input to \code{get.tau}} @@ -61,11 +68,13 @@ lines(r.mid, null.ci[2,] , lty=2) } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.ci}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau.typed}}, \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.Rd b/man/get.tau.typed.Rd index c5a4121..b88503f 100644 --- a/man/get.tau.typed.Rd +++ b/man/get.tau.typed.Rd @@ -4,8 +4,15 @@ \alias{get.tau.typed} \title{Optimized version of \code{get.tau} for typed data} \usage{ -get.tau.typed(posmat, typeA = -1, typeB = -1, r = 1, r.low = rep(0, - length(r)), comparison.type = "representative", data.frame = TRUE) +get.tau.typed( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -56,11 +63,13 @@ abline(h=1,lty=2) } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.ci}}, \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.bootstrap.Rd b/man/get.tau.typed.bootstrap.Rd index 9b62a4c..cb350a8 100644 --- a/man/get.tau.typed.bootstrap.Rd +++ b/man/get.tau.typed.bootstrap.Rd @@ -4,9 +4,16 @@ \alias{get.tau.typed.bootstrap} \title{runs bootstrapping for \code{get.tau.typed}} \usage{ -get.tau.typed.bootstrap(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), boot.iter, - comparison.type = "representative", data.frame = TRUE) +get.tau.typed.bootstrap( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + boot.iter, + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -70,10 +77,13 @@ lines(r.mid, ci[2,] , lty=2) } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.ci}}, \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.permute}}, - \code{\link{get.tau.typed}}, \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.permute.Rd b/man/get.tau.typed.permute.Rd index 9958292..7a9d907 100644 --- a/man/get.tau.typed.permute.Rd +++ b/man/get.tau.typed.permute.Rd @@ -4,9 +4,16 @@ \alias{get.tau.typed.permute} \title{get the null distribution for the \code{get.tau.typed} function} \usage{ -get.tau.typed.permute(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), permutations, - comparison.type = "representative", data.frame = TRUE) +get.tau.typed.permute( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + permutations, + comparison.type = "representative", + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -66,10 +73,13 @@ lines(r.mid, null.ci[2,] , lty=2) } } \seealso{ -Other get.tau: \code{\link{get.tau.bootstrap}}, - \code{\link{get.tau.ci}}, \code{\link{get.tau.permute}}, - \code{\link{get.tau.typed.bootstrap}}, - \code{\link{get.tau.typed}}, \code{\link{get.tau}} +Other get.tau: +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.Rd b/man/get.theta.Rd index 8d38a0d..17046fa 100644 --- a/man/get.theta.Rd +++ b/man/get.theta.Rd @@ -4,12 +4,11 @@ \alias{get.theta} \title{Generalized version of \code{get.theta}} \usage{ -get.theta(posmat, fun, r = 1, r.low = rep(0, length(r)), - data.frame = TRUE) +get.theta(posmat, fun, r = 1, r.low = rep(0, length(r)), data.frame = TRUE) } \arguments{ -\item{posmat}{a matrix with columns x, y and any other named columns -columns needed by fun} +\item{posmat}{a matrix with columns x, y and any other named +columns needed by \code{fun}} \item{fun}{a function that takes in two rows of posmat and returns: \enumerate{ @@ -56,15 +55,17 @@ sero.theta<-get.theta(DengueSimR02,sero.type.func,r=r.max,r.low=r.min) } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.ci}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta.typed}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta.typed}()} -Other spatialtau: \code{\link{get.pi}}, - \code{\link{get.tau}} +Other spatialtau: +\code{\link{get.pi}()}, +\code{\link{get.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.bootstrap.Rd b/man/get.theta.bootstrap.Rd index 9c4a76c..6ba47e7 100644 --- a/man/get.theta.bootstrap.Rd +++ b/man/get.theta.bootstrap.Rd @@ -4,8 +4,14 @@ \alias{get.theta.bootstrap} \title{Bootstrap \code{get.theta} values.} \usage{ -get.theta.bootstrap(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter = 500, data.frame = TRUE) +get.theta.bootstrap( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 500, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -64,11 +70,13 @@ lines(r.mid, theta.ci[2,] , lty=2) } } \seealso{ -Other get.theta: \code{\link{get.theta.ci}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta.typed}}, \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta.typed}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.ci.Rd b/man/get.theta.ci.Rd index 3818a53..ac8f572 100644 --- a/man/get.theta.ci.Rd +++ b/man/get.theta.ci.Rd @@ -4,9 +4,16 @@ \alias{get.theta.ci} \title{Calculate bootstrapped confidence intervals for \code{get.theta} values.} \usage{ -get.theta.ci(posmat, fun, r = 1, r.low = rep(0, length(r)), - boot.iter = 1000, ci.low = 0.025, ci.high = 0.975, - data.frame = TRUE) +get.theta.ci( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 1000, + ci.low = 0.025, + ci.high = 0.975, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -61,11 +68,13 @@ lines(r.mid, theta.ci[,3] , lty=2) } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta.typed}}, \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta.typed}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler diff --git a/man/get.theta.permute.Rd b/man/get.theta.permute.Rd index 970bc4a..2479823 100644 --- a/man/get.theta.permute.Rd +++ b/man/get.theta.permute.Rd @@ -4,8 +4,14 @@ \alias{get.theta.permute} \title{get the null distribution of the \code{get.theta} function} \usage{ -get.theta.permute(posmat, fun, r = 1, r.low = rep(0, length(r)), - permutations, data.frame = TRUE) +get.theta.permute( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + permutations, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -58,10 +64,12 @@ lines(r.mid, null.ci[2,] , lty=2) } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.ci}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta.typed}}, \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta.typed}()}, +\code{\link{get.theta}()} } \concept{get.theta} diff --git a/man/get.theta.typed.Rd b/man/get.theta.typed.Rd index fa4136e..032f61e 100644 --- a/man/get.theta.typed.Rd +++ b/man/get.theta.typed.Rd @@ -4,8 +4,14 @@ \alias{get.theta.typed} \title{Optimized version of \code{get.theta} for typed data.} \usage{ -get.theta.typed(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), data.frame = TRUE) +get.theta.typed( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -45,12 +51,13 @@ typed.theta.R01<-get.theta.typed(tmp,typeA=2,typeB=2,r=r.max,r.low=r.min) } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.ci}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.typed.bootstrap.Rd b/man/get.theta.typed.bootstrap.Rd index a1a6c30..b124978 100644 --- a/man/get.theta.typed.bootstrap.Rd +++ b/man/get.theta.typed.bootstrap.Rd @@ -4,8 +4,15 @@ \alias{get.theta.typed.bootstrap} \title{runs bootstrapping on \code{get.theta.typed}} \usage{ -get.theta.typed.bootstrap(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), boot.iter, data.frame = TRUE) +get.theta.typed.bootstrap( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + boot.iter, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -46,10 +53,12 @@ typed.theta.bs<-get.theta.typed.bootstrap(tmp,typeA=1,typeB=2,r=r.max,r.low=r.mi } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.ci}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.permute}}, - \code{\link{get.theta.typed}}, \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.permute}()}, +\code{\link{get.theta.typed}()}, +\code{\link{get.theta}()} } \concept{get.theta} diff --git a/man/get.theta.typed.permute.Rd b/man/get.theta.typed.permute.Rd index 8204db5..35e9402 100644 --- a/man/get.theta.typed.permute.Rd +++ b/man/get.theta.typed.permute.Rd @@ -4,8 +4,15 @@ \alias{get.theta.typed.permute} \title{get the null distribution of the get.theta.typed function} \usage{ -get.theta.typed.permute(posmat, typeA = -1, typeB = -1, r = 1, - r.low = rep(0, length(r)), permutations, data.frame = TRUE) +get.theta.typed.permute( + posmat, + typeA = -1, + typeB = -1, + r = 1, + r.low = rep(0, length(r)), + permutations, + data.frame = TRUE +) } \arguments{ \item{posmat}{a matrix with columns type, x and y} @@ -49,11 +56,13 @@ typed.theta.type.null<-get.theta.typed.permute(tmp, typeA=1, typeB=2, } } \seealso{ -Other get.theta: \code{\link{get.theta.bootstrap}}, - \code{\link{get.theta.ci}}, - \code{\link{get.theta.permute}}, - \code{\link{get.theta.typed.bootstrap}}, - \code{\link{get.theta.typed}}, \code{\link{get.theta}} +Other get.theta: +\code{\link{get.theta.bootstrap}()}, +\code{\link{get.theta.ci}()}, +\code{\link{get.theta.permute}()}, +\code{\link{get.theta.typed.bootstrap}()}, +\code{\link{get.theta.typed}()}, +\code{\link{get.theta}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.transdist.theta.Rd b/man/get.transdist.theta.Rd index 70d8934..8cf526c 100644 --- a/man/get.transdist.theta.Rd +++ b/man/get.transdist.theta.Rd @@ -4,8 +4,13 @@ \alias{get.transdist.theta} \title{Get weights of transmission distance theta} \usage{ -get.transdist.theta(wal.teun.mat, cases, gen.t.mean, max.sep, - ret.theta.mat = FALSE) +get.transdist.theta( + wal.teun.mat, + cases, + gen.t.mean, + max.sep, + ret.theta.mat = FALSE +) } \arguments{ \item{wal.teun.mat}{a Wallinga-Teunis matrix produced by the \code{est.wt.matrix} function} @@ -49,11 +54,12 @@ a <- get.transdist.theta(wal.teun.mat=wt, Salje H, Cummings DAT and Lessler J (2016). “Estimating infectious disease transmission distances using the overall distribution of cases.” Epidemics, 17, pp. 10–18. ISSN 1755-4365, doi: \href{https://www.sciencedirect.com/science/article/pii/S1755436516300317}{10.1016/j.epidem.2016.10.001}. } \seealso{ -Other transdist: \code{\link{est.transdist.bootstrap.ci}}, - \code{\link{est.transdist.temporal.bootstrap.ci}}, - \code{\link{est.transdist.temporal}}, - \code{\link{est.transdist.theta.weights}}, - \code{\link{est.transdist}} +Other transdist: +\code{\link{est.transdist.bootstrap.ci}()}, +\code{\link{est.transdist.temporal.bootstrap.ci}()}, +\code{\link{est.transdist.temporal}()}, +\code{\link{est.transdist.theta.weights}()}, +\code{\link{est.transdist}()} } \author{ John Giles, Justin Lessler, and Henrik Salje diff --git a/man/sim.epidemic.Rd b/man/sim.epidemic.Rd index d7532a4..7e78fd7 100644 --- a/man/sim.epidemic.Rd +++ b/man/sim.epidemic.Rd @@ -4,8 +4,15 @@ \alias{sim.epidemic} \title{Simulation of an epidemic in space and time} \usage{ -sim.epidemic(R, gen.t.mean, gen.t.sd, trans.kern.func, - tot.generations = 10, min.cases = 0, max.try = 1000) +sim.epidemic( + R, + gen.t.mean, + gen.t.sd, + trans.kern.func, + tot.generations = 10, + min.cases = 0, + max.try = 1000 +) } \arguments{ \item{R}{a scalar or a vector of length \code{tot.generations} providing the reproductive number for the epidemic. From 283ce359d3873f6302178419eb25b3b1745716db Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 13 Feb 2020 09:09:23 +0000 Subject: [PATCH 10/70] Apply coxed::bca --- R/spatialfuncs.r | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 4248228..5cd1a1f 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -240,11 +240,10 @@ get.theta.typed <- function(posmat, ##' @param r the upper end of each distance band ##' @param r.low the low end of each distance band (default: a vector of zeroes) ##' @param boot.iter the number of bootstrap iterations (default = 1000) -##' @param ci.low the low end of the BCa CI (default = 0.025) -##' @param ci.high the high end of the BCa CI (default = 0.975) +##' @param ci.level the level of the desired BCa CI (default = 0.95) ##' @param data.frame logical: indicating whether to return results as a data frame (default = TRUE) ##' -##' @return If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. +##' @return If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), the confidence envelope as \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. ##' ##' @author Justin Lessler and Timothy M Pollington ##' @@ -265,13 +264,12 @@ get.pi.ci <- function(posmat, r=1, r.low=rep(0,length(r)), boot.iter = 1000, - ci.low=0.025, - ci.high=0.975, + ci.level=0.95, data.frame=TRUE) { boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) - rc <- apply(boots[,-(1:2)], 1, quantile, probs=c(ci.low, ci.high)) + rc <- apply(boots[,-(1:2)], 1, coxed::bca, conf.level = ci.level) if (data.frame == FALSE) { return(rc) From 7b6436f4739b5fe9537511c39ff27d6e1d143a7c Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 13 Feb 2020 10:52:24 +0000 Subject: [PATCH 11/70] Remove code as already warned that it would be deprecated last time. --- inst/tests/test-getpibootstrap.r | 30 +----------------------------- 1 file changed, 1 insertion(+), 29 deletions(-) diff --git a/inst/tests/test-getpibootstrap.r b/inst/tests/test-getpibootstrap.r index 029f8cd..407e766 100644 --- a/inst/tests/test-getpibootstrap.r +++ b/inst/tests/test-getpibootstrap.r @@ -1,6 +1,6 @@ context("get.pi.bootstrap") -test_that("get.pi.boostrap runs and returns 1 when it should", { +test_that("get.pi.bootstrap runs and returns 1 when it should", { x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) @@ -142,31 +142,3 @@ test_that ("fails nicely if x and y column names are not provided", { expect_that(get.pi.ci(x,test,seq(10,50,10), seq(0,40,10),100), throws_error("unique x and y columns must be defined")) }) - - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND - - - -## test_that("CIs calculated from get.pi.bootstrap include the true value", { -## set.seed(787) - -## x<-cbind(rep(c(1,2),250), x=runif(500,0,100), y=runif(500,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## res <- get.pi.ci(x, test, seq(10,100,10), seq(0,90,10), 100) - -## expect_that(sum(!(res[1,].5)),equals(0)) -## }) - - From e1033b466fe805166207cdf6656d8108d6b022ab Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 13 Feb 2020 11:24:36 +0000 Subject: [PATCH 12/70] Add get.pi.ci() changes to NEWS. --- NEWS.md | 3 ++- man/get.pi.ci.Rd | 9 +++------ 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1dd7d30..d54708b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,7 @@ -# IDSpatialStats 0.4.0 +# IDSpatialStats 1.0.0 ## Changes (top of list are most important) +* `get.pi.ci()`: `quantile` method replaced with `coxed::bca` * NEWS.md file added * CITATION file added * README.md formatting updated diff --git a/man/get.pi.ci.Rd b/man/get.pi.ci.Rd index 098fc39..a1e1767 100644 --- a/man/get.pi.ci.Rd +++ b/man/get.pi.ci.Rd @@ -10,8 +10,7 @@ get.pi.ci( r = 1, r.low = rep(0, length(r)), boot.iter = 1000, - ci.low = 0.025, - ci.high = 0.975, + ci.level = 0.95, data.frame = TRUE ) } @@ -26,14 +25,12 @@ get.pi.ci( \item{boot.iter}{the number of bootstrap iterations (default = 1000)} -\item{ci.low}{the low end of the BCa CI (default = 0.025)} - -\item{ci.high}{the high end of the BCa CI (default = 0.975)} +\item{ci.level}{the level of the desired BCa CI (default = 0.95)} \item{data.frame}{logical: indicating whether to return results as a data frame (default = TRUE)} } \value{ -If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. +If \code{data.frame = TRUE} then a data frame of 5 variables \code{r.low}, \code{r}, \code{pt.est} (the point estimate from \code{get.pi}), the confidence envelope as \code{ci.low} and \code{ci.high}, with the observations representing ascending distance bands. Else a matrix with first row \code{ci.low} and second row \code{ci.high} with columns representing ascending distance bands. } \description{ Wrapper using \pkg{coxed} package to calculate the From 99fa3cb44379efec3def3a26117bbffccdc80d32 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 13 Feb 2020 11:26:44 +0000 Subject: [PATCH 13/70] Add imports for coxed as needed by get.pi.ci() --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index fdf57ab..85f1f1c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,7 @@ Description: Implements various novel and standard spread of infectious disease. RoxygenNote: 7.0.2 Encoding: UTF-8 -Imports: igraph, spatstat +Imports: igraph, spatstat, coxed Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr From ca514512b6a6174f7868ad85678fb8ae8fcee7e4 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 4 Mar 2020 19:33:50 +0000 Subject: [PATCH 14/70] Add coxed import --- NAMESPACE | 1 + 1 file changed, 1 insertion(+) diff --git a/NAMESPACE b/NAMESPACE index 1985ef6..a00b806 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,4 @@ +import("coxed") import("parallel") import("doParallel") import("foreach") From 203369259ae4006b11fa2fd209575899e8bde217 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 11 Mar 2020 19:22:20 +0000 Subject: [PATCH 15/70] Update refs --- R/spatialfuncs.r | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 5cd1a1f..224cba5 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -247,9 +247,10 @@ get.theta.typed <- function(posmat, ##' ##' @author Justin Lessler and Timothy M Pollington ##' -##' @references \href{https://arxiv.org/pdf/1911.08022.pdf#page=18}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2019) -##' Measuring spatiotemporal disease clustering with the tau statistic. -##' *arXiv/stat.ME: 1911.08022v3*. +##' @references \href{https://arxiv.org/pdf/1911.08022v4.pdf#page=12}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2020) +##' Developments in statistical inference when assessing +##' spatiotemporal disease clustering with the tau statistic. +##' *arXiv/stat.ME: 1911.08022v4*. ##' ##' @family get.pi ##' @@ -261,11 +262,11 @@ get.theta.typed <- function(posmat, get.pi.ci <- function(posmat, fun, - r=1, - r.low=rep(0,length(r)), + r = 1, + r.low = rep(0,length(r)), boot.iter = 1000, - ci.level=0.95, - data.frame=TRUE) { + ci.level = 0.95, + data.frame = TRUE) { boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) @@ -274,19 +275,19 @@ get.pi.ci <- function(posmat, if (data.frame == FALSE) { return(rc) } else if (data.frame == TRUE) { - return(data.frame(r.low=r.low, - r=r, - pt.est=get.pi(posmat, fun, r, r.low)$pi, - ci.low=rc[1,], - ci.high=rc[2,])) + return(data.frame(r.low = r.low, + r = r, + pt.est = get.pi(posmat, fun, r, r.low)$pi, + ci.low = rc[1,], + ci.high = rc[2,])) } } - + ##' Calculate bootstrapped confidence intervals for \code{get.theta} values. ##' ##' Wrapper to \code{get.theta.bootstrap} that takes care of calculating the -##' confience intervals based on the bootstrapped values. +##' confidence intervals based on the bootstrapped values. ##' ##' ##' @param posmat a matrix with columns type, x and y @@ -367,7 +368,7 @@ get.pi.bootstrap <- function(posmat, data.frame=TRUE) { - xcol <- which(colnames(posmat)=="x") + xcol <- which(colnames(posmat)=="x") ycol <- which(colnames(posmat)=="y") #check that both columns exist From e84fcec2e983fc0fa22bea8fa711de4bf94d102a Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 12 Mar 2020 13:39:55 +0000 Subject: [PATCH 16/70] Partly fix get.pi.bootstrap() tests --- inst/tests/test-getpibootstrap.r | 41 ++++++++++++-------------------- man/get.pi.ci.Rd | 7 +++--- man/get.theta.ci.Rd | 2 +- 3 files changed, 20 insertions(+), 30 deletions(-) diff --git a/inst/tests/test-getpibootstrap.r b/inst/tests/test-getpibootstrap.r index 407e766..71503ba 100644 --- a/inst/tests/test-getpibootstrap.r +++ b/inst/tests/test-getpibootstrap.r @@ -2,25 +2,24 @@ context("get.pi.bootstrap") test_that("get.pi.bootstrap runs and returns 1 when it should", { - x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) + x <- cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) - colnames(x) <-c("type","x","y") + colnames(x) <- c("type","x","y") test <- function(a,b) {return(1)} - #should return a matrix of all ones + # should return a matrix of all ones res <- get.pi.bootstrap(x, test, seq(10,100,10), seq(0,90,10), 20)[,-(1:2)] expect_that(sum(res!=1),equals(0)) expect_that(ncol(res),equals(20)) - + }) - -test_that("get.pi.ci returns bootstrap cis when same seed", { +test_that("get.pi.ci returns bootstrap CIs when same seed", { - x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) + x <- cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) - colnames(x) <-c("type","x","y") + colnames(x) <- c("type","x","y") test <- function(a,b) { if (a[1] != 1) return(3) @@ -32,27 +31,20 @@ test_that("get.pi.ci returns bootstrap cis when same seed", { res <- get.pi.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:2)] set.seed(787) - ci1 <- get.pi.ci(x, test, seq(15,45,15), seq(0,30,15), 20)[,4:5] + ci1 <- get.pi.ci(x, test, seq(15,45,15), seq(0,30,15), 20, ci.level = 0.95)[,4:5] - expect_that(as.numeric(ci1[1,]), - equals(as.numeric(quantile(res[1,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[1,]), + equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) expect_that(as.numeric(ci1[2,]), - equals(as.numeric(quantile(res[2,], - probs=c(.025,.975), - na.rm=T)))) + equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) expect_that(as.numeric(ci1[3,]), - equals(as.numeric(quantile(res[3,], - probs=c(.025,.975), - na.rm=T)))) - + equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) + }) - test_that("performs correctly for test case 1 (equilateral triangle)", { x <- rbind(c(1,0,0), c(1,1,0),c(2,.5,sqrt(.75))) colnames(x) <-c("type","x","y") @@ -71,16 +63,14 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { equals(c(0,1))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), equals(c(0,1))) - - }) test_that("performs correctly for test case 2 (points on a line)", { - x<-rbind(c(1,0,0), c(2,1,0), c(2,-1,0), c(3,2,0), + x <- rbind(c(1,0,0), c(2,1,0), c(2,-1,0), c(3,2,0), c(2,-2,0), c(3,3,0),c(3,-3,0)) - colnames(x) <-c("type","x","y") + colnames(x) <- c("type","x","y") test <- function(a,b) { if (a[1] != 1) return(3) @@ -100,7 +90,6 @@ test_that("performs correctly for test case 2 (points on a line)", { expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(0.5)) expect_that(median(as.numeric(res2[3,]), na.rm=T), equals(0)) - #FIRST RANGE #deterministically 1 expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), diff --git a/man/get.pi.ci.Rd b/man/get.pi.ci.Rd index a1e1767..dc8cfa2 100644 --- a/man/get.pi.ci.Rd +++ b/man/get.pi.ci.Rd @@ -71,9 +71,10 @@ lines(r.mid, pi.ci$ci.low, lty=2) lines(r.mid, pi.ci$ci.high, lty=2)} } \references{ -\href{https://arxiv.org/pdf/1911.08022.pdf#page=18}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2019) -Measuring spatiotemporal disease clustering with the tau statistic. -\emph{arXiv/stat.ME: 1911.08022v3}. +\href{https://arxiv.org/pdf/1911.08022v4.pdf#page=12}{Rationale for BCa rather than percentile CIs} is described in Pollington et al. (2020) +Developments in statistical inference when assessing +spatiotemporal disease clustering with the tau statistic. +\emph{arXiv/stat.ME: 1911.08022v4}. } \seealso{ Other get.pi: diff --git a/man/get.theta.ci.Rd b/man/get.theta.ci.Rd index ac8f572..cc54fba 100644 --- a/man/get.theta.ci.Rd +++ b/man/get.theta.ci.Rd @@ -38,7 +38,7 @@ a matrix with a row for the high and low values and } \description{ Wrapper to \code{get.theta.bootstrap} that takes care of calculating the -confience intervals based on the bootstrapped values. +confidence intervals based on the bootstrapped values. } \examples{ \donttest{ From d9d1b37595b6decc052d4a9aa636dbfa26249267 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 12 Mar 2020 14:36:29 +0000 Subject: [PATCH 17/70] Fix: [,-(1:2)] removed as already run from get.pi.bootstrap() --- R/spatialfuncs.r | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 224cba5..e2ad0d6 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -270,7 +270,7 @@ get.pi.ci <- function(posmat, boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) - rc <- apply(boots[,-(1:2)], 1, coxed::bca, conf.level = ci.level) + rc <- apply(boots, 1, coxed::bca, conf.level = ci.level) if (data.frame == FALSE) { return(rc) @@ -367,7 +367,6 @@ get.pi.bootstrap <- function(posmat, boot.iter=500, data.frame=TRUE) { - xcol <- which(colnames(posmat)=="x") ycol <- which(colnames(posmat)=="y") From 76d6c168eecbeaa6e99d949e68c703d5cb4f195f Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 13:55:40 +0000 Subject: [PATCH 18/70] Apply to get.pi.ci() complete. Now apply to get.theta.ci(). --- R/spatialfuncs.r | 15 ++++++++++++--- inst/tests/test-getpipermute.r | 2 +- man/get.pi.bootstrap.Rd | 4 +++- 3 files changed, 16 insertions(+), 5 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index e2ad0d6..7d31225 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -269,8 +269,15 @@ get.pi.ci <- function(posmat, data.frame = TRUE) { boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) - - rc <- apply(boots, 1, coxed::bca, conf.level = ci.level) + boots = boots[,-(1:2)] + + applyBCa <- function(boots, ci.level){ + boots = boots[!is.na(boots)] + CI = coxed::bca(boots, conf.level = ci.level) + return(CI) + } + + rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) @@ -347,7 +354,9 @@ get.theta.ci <- function(posmat, ##' @param boot.iter the number of bootstrap iterations ##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) ##' -##' @return pi values for all the distances we looked at +##' @return Values of pi for all distance bands. Return value dependent on data.frame argument. +##' Asa matrix (rows = bootstrap samples, columns = increasing distance bands) +##' or a data.frame (r.low, r and increasing distance bands) ##' ##' @note In each bootstrap iteration N observations are drawn from the existing data with replacement. To avoid errors in ##' inference resulting from the same observatin being compared with itself in the bootstrapped data set, original indices diff --git a/inst/tests/test-getpipermute.r b/inst/tests/test-getpipermute.r index 2701617..9fbd341 100644 --- a/inst/tests/test-getpipermute.r +++ b/inst/tests/test-getpipermute.r @@ -51,7 +51,7 @@ test_that("get.pi.permute returns appropriate values for test case 2 (points on #without windows the 95% CI should be around 2* 0.5+/- 1/sqrt(4) * 0.25 #since quantiles, that is 0.25 and 0.75 res <- get.pi.permute(x, test, 4,0, 500) - res2 <- get.pi.typed.permute(x, 1, 2, 4,0, 500) + res2 <- get.pi.typed.permute(x, 1, 2, 4, 0, 500) expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975))), equals(c(0.25,0.75))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975))), diff --git a/man/get.pi.bootstrap.Rd b/man/get.pi.bootstrap.Rd index 5beab5d..fdcbbe6 100644 --- a/man/get.pi.bootstrap.Rd +++ b/man/get.pi.bootstrap.Rd @@ -27,7 +27,9 @@ get.pi.bootstrap( \item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} } \value{ -pi values for all the distances we looked at +Values of pi for all distance bands. Return value dependent on data.frame argument. +Asa matrix (rows = bootstrap samples, columns = increasing distance bands) +or a data.frame (r.low, r and increasing distance bands) } \description{ Runs \code{get.pi} on multiple bootstraps of the data. Is formulated From aa6f12de93d8caa91b71425cb4117e11b8734217 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 13:58:48 +0000 Subject: [PATCH 19/70] Unnest applyBCa() so available to all functions. --- R/spatialfuncs.r | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 7d31225..fea898d 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -260,6 +260,12 @@ get.theta.typed <- function(posmat, ##' @example R/examples/get_pi_ci.R ##' @md +applyBCa <- function(boots, ci.level){ + boots = boots[!is.na(boots)] + CI = coxed::bca(boots, conf.level = ci.level) + return(CI) +} + get.pi.ci <- function(posmat, fun, r = 1, @@ -271,12 +277,6 @@ get.pi.ci <- function(posmat, boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) boots = boots[,-(1:2)] - applyBCa <- function(boots, ci.level){ - boots = boots[!is.na(boots)] - CI = coxed::bca(boots, conf.level = ci.level) - return(CI) - } - rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { From 215ea85bdb0b20a14104fddc6482e0f6e0bcc2ba Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 15:02:46 +0000 Subject: [PATCH 20/70] get.theta.ci() implemented. Except for mention of this in its help file. --- NEWS.md | 2 +- R/spatialfuncs.r | 4 ++-- inst/tests/test-getthetabootstrap.r | 22 ++++++++-------------- 3 files changed, 11 insertions(+), 17 deletions(-) diff --git a/NEWS.md b/NEWS.md index d54708b..a9849ba 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,7 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) -* `get.pi.ci()`: `quantile` method replaced with `coxed::bca` +* `get.pi.ci()`, `get.theta.ci()`: `quantile` method replaced with `coxed::bca` * NEWS.md file added * CITATION file added * README.md formatting updated diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index fea898d..3a7a6f3 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -326,8 +326,8 @@ get.theta.ci <- function(posmat, data.frame=TRUE) { boots <- get.theta.bootstrap(posmat, fun, r, r.low, boot.iter) - - rc <- apply(boots[,-(1:2)], 1, quantile, probs=c(ci.low, ci.high)) + boots = boots[,-(1:2)] + rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) diff --git a/inst/tests/test-getthetabootstrap.r b/inst/tests/test-getthetabootstrap.r index a4372dd..3863fbf 100644 --- a/inst/tests/test-getthetabootstrap.r +++ b/inst/tests/test-getthetabootstrap.r @@ -1,6 +1,6 @@ context("get.theta.bootstrap") -test_that("get.theta.boostrap runs and returns Inf when all relations are 1", { +test_that("get.theta.bootstrap runs and returns Inf when all relations are 1", { x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) @@ -31,22 +31,16 @@ test_that("get.theta.ci returns bootstrap cis when same seed", { res <- get.theta.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:2)] set.seed(787) - ci1 <- get.theta.ci(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:3)] - - expect_that(as.numeric(ci1[1,]), - equals(as.numeric(quantile(res[1,], - probs=c(.025,.975), - na.rm=T)))) + ci1 <- get.theta.ci(x, test, seq(15,45,15), seq(0,30,15), 20, ci.level = 0.95)[,-(1:3)] + expect_that(as.numeric(ci1[1,]), + equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) + expect_that(as.numeric(ci1[2,]), - equals(as.numeric(quantile(res[2,], - probs=c(.025,.975), - na.rm=T)))) - + equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) + expect_that(as.numeric(ci1[3,]), - equals(as.numeric(quantile(res[3,], - probs=c(.025,.975), - na.rm=T)))) + equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) }) From 64ee7417e7e9ab5adea5a57f02d80e883c0c521e Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 15:08:29 +0000 Subject: [PATCH 21/70] get.theta.ci(): update args --- R/spatialfuncs.r | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 3a7a6f3..85bf1eb 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -321,8 +321,7 @@ get.theta.ci <- function(posmat, r=1, r.low=rep(0,length(r)), boot.iter = 1000, - ci.low=0.025, - ci.high=0.975, + ci.level=0.95, data.frame=TRUE) { boots <- get.theta.bootstrap(posmat, fun, r, r.low, boot.iter) From 85ce85610608cffb6f7502c8e4eab9b237de1a3b Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 15:59:28 +0000 Subject: [PATCH 22/70] Update: get.tau.ci() with BCa --- NEWS.md | 2 +- R/spatialfuncs.r | 11 ++++----- inst/tests/test-gettaubootstrap.r | 40 +++++++++++-------------------- 3 files changed, 19 insertions(+), 34 deletions(-) diff --git a/NEWS.md b/NEWS.md index a9849ba..1b39634 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,7 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) -* `get.pi.ci()`, `get.theta.ci()`: `quantile` method replaced with `coxed::bca` +* `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` * NEWS.md file added * CITATION file added * README.md formatting updated diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 85bf1eb..86bb608 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1008,15 +1008,12 @@ get.tau.ci <- function(posmat, r.low=rep(0,length(r)), boot.iter = 1000, comparison.type = "representative", - ci.low=0.025, - ci.high=0.975, + ci.level = 0.95, data.frame=TRUE) { - boots <- get.tau.bootstrap(posmat, fun, - r, r.low, boot.iter, - comparison.type) - - rc <- apply(boots[,-(1:2)], 1, quantile, probs=c(ci.low, ci.high)) + boots <- get.tau.bootstrap(posmat, fun, r, r.low, boot.iter, comparison.type) + boots = boots[,-(1:2)] + rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index ba62690..d106b83 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -205,22 +205,17 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { res <- get.tau.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:2)] set.seed(787) - ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:3)] + ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type = "representative", + ci.level = 0.95)[,-(1:3)] - expect_that(as.numeric(ci1[1,]), - equals(as.numeric(quantile(res[1,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[1,]), + equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[2,]), - equals(as.numeric(quantile(res[2,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[2,]), + equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[3,]), - equals(as.numeric(quantile(res[3,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[3,]), + equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) ### INDEPENDENT set.seed(787) @@ -231,24 +226,17 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type="independent")[,-(1:3)] - expect_that(as.numeric(ci1[1,]), - equals(as.numeric(quantile(res[1,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[1,]), + equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[2,]), - equals(as.numeric(quantile(res[2,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[2,]), + equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[3,]), - equals(as.numeric(quantile(res[3,], - probs=c(.025,.975), - na.rm=T)))) + expect_that(as.numeric(ci1[3,]), + equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) }) - test_that("fails nicely if x and y column names are not provided", { x<-cbind(rep(c(1,2),500), a=runif(1000,0,100), b=runif(1000,0,100)) From 949c4a71b7db3984b096b1d49757951ee97eb5b1 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 23:05:48 +0000 Subject: [PATCH 23/70] Update other quantile() methods where applicable. --- inst/tests/test-getpibootstrap.r | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/inst/tests/test-getpibootstrap.r b/inst/tests/test-getpibootstrap.r index 71503ba..dfe41a0 100644 --- a/inst/tests/test-getpibootstrap.r +++ b/inst/tests/test-getpibootstrap.r @@ -56,12 +56,14 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { } res <- get.pi.bootstrap(x, test, 1.5, 0.1, 500)[,-(1:2)] + res = res[!is.na(res)] res2 <- get.pi.typed.bootstrap(x, 1,2, 1.5, 0.1, 500)[,-(1:2)] - + res2 = res2[!is.na(res2)] + #should have 95% CI of 0,1 and mean/median of 0.5 - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), + expect_that(coxed::bca(res, conf.level = 0.95), equals(c(0,1))) - expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), + expect_that(coxed::bca(res2, conf.level = 0.95), equals(c(0,1))) }) @@ -90,27 +92,35 @@ test_that("performs correctly for test case 2 (points on a line)", { expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(0.5)) expect_that(median(as.numeric(res2[3,]), na.rm=T), equals(0)) + # For the first and third ranges we use the quantile method as the BCa method breaks down for + # constant vectors of ones or zeroes + #FIRST RANGE #deterministically 1 + expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) #SECOND RANGE...should be 0 and 1 respectively a fairly large % of the time - expect_that(as.numeric(quantile(res[2,], probs=c(0.025,.975), na.rm=T)), + res1.2 = na.omit(as.numeric(res[2,])) + res2.2 = na.omit(as.numeric(res2[2,])) + + expect_that(coxed::bca(as.numeric(res1.2), conf.level = 0.95), equals(c(0,1))) - expect_that(as.numeric(quantile(res2[2,], probs=c(.025,.975), na.rm=T)), + expect_that(coxed::bca(as.numeric(res2.2), conf.level = 0.95), equals(c(0,1))) + #THIRD RANGE #deterministically 0 + expect_that(as.numeric(quantile(res[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) expect_that(as.numeric(quantile(res2[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) - }) From 04c379c6d482d576c72f97cace234f5b9aafa069 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Sun, 15 Mar 2020 23:38:18 +0000 Subject: [PATCH 24/70] Update: commented in getthetapermute.r that coxed::bca() is unavailable due to breaking down under vector of zeroes or one or Infs. --- NEWS.md | 4 +++- inst/tests/test-getthetapermute.r | 11 +++++++---- 2 files changed, 10 insertions(+), 5 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1b39634..77b50b4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,9 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) -* `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` +* `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to + compute BCa (bias-corrected and accelerated) confidence intervals (CIs) rather than percentile. + Note this will result in a change in your results versus previous versions if if computing CIs. * NEWS.md file added * CITATION file added * README.md formatting updated diff --git a/inst/tests/test-getthetapermute.r b/inst/tests/test-getthetapermute.r index 7444711..f3272a3 100644 --- a/inst/tests/test-getthetapermute.r +++ b/inst/tests/test-getthetapermute.r @@ -34,9 +34,9 @@ test_that("get.theta.permute returns appropriate values for test case 2 (points return(2) } - #the median of the null distribution should be 1 (includes infs so - # mean does not work) - #the 95% CI equals 0,Inf with windows + #the median of the null distribution should be 1 (includes infs so mean does not work) + #the 95% CI equals 0,Inf with windows. As it contains Infs we use quantile() rather than bca() + #to compute the confidence interval res <- get.theta.permute(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:2)] res2 <- get.theta.typed.permute(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:2)] @@ -50,9 +50,12 @@ test_that("get.theta.permute returns appropriate values for test case 2 (points equals(c(0,Inf))) } - #without windows the 95% CI should be 1/3 and 3 + #without windows the 95% CI should be 1/3 and 3. As it contains Infs we use quantile() rather + # than coxed::bca() to compute the confidence interval res <- get.theta.permute(x, test, 4,0, 500)[,-(1:2)] res2 <- get.theta.typed.permute(x, 1, 2, 4,0, 500)[,-(1:2)] + + expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975))), equals(c(1/3,3))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975))), From eabb8fe02590f9bbc398e54f68e87083bb5ba27f Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 11:45:19 +0000 Subject: [PATCH 25/70] Replace quantile() with coxed::bca where possible. Removed previously deprecated code. --- NEWS.md | 5 ++ inst/tests/test-getpipermute.r | 97 +++-------------------------- inst/tests/test-gettaubootstrap.r | 57 +++-------------- inst/tests/test-getthetabootstrap.r | 6 +- 4 files changed, 26 insertions(+), 139 deletions(-) diff --git a/NEWS.md b/NEWS.md index 77b50b4..796b8ff 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,8 +4,13 @@ * `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to compute BCa (bias-corrected and accelerated) confidence intervals (CIs) rather than percentile. Note this will result in a change in your results versus previous versions if if computing CIs. + `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. + At times the `coxed::bca()` method gives slightly different test results if it is applied to + asymmetric distributions. * NEWS.md file added * CITATION file added * README.md formatting updated +* Deprecated tests that were previously commented out in `inst/tests/` as a warning of removal + have not been removed. ## Bug fixes (top of list are most important) diff --git a/inst/tests/test-getpipermute.r b/inst/tests/test-getpipermute.r index 9fbd341..5e422f9 100644 --- a/inst/tests/test-getpipermute.r +++ b/inst/tests/test-getpipermute.r @@ -42,24 +42,23 @@ test_that("get.pi.permute returns appropriate values for test case 2 (points on expect_that(rowMeans(res2, na.rm=T), equals(rep(.5,3), tolerance=0.1)) for (i in 1:3) { - expect_that(as.numeric(quantile(res[i,], probs=c(.025,.975))), + expect_that(coxed::bca(as.numeric(res[i,]), conf.level = 0.95), equals(c(0,1))) - expect_that(as.numeric(quantile(res2[i,], probs=c(.025,.975))), + expect_that(coxed::bca(as.numeric(res2[i,]), conf.level = 0.95), equals(c(0,1))) } - #without windows the 95% CI should be around 2* 0.5+/- 1/sqrt(4) * 0.25 - #since quantiles, that is 0.25 and 0.75 + #without windows the distributions is asymmetric and 95% BCa CI is rather than [0.25,0.75] for + # percentile CIs res <- get.pi.permute(x, test, 4,0, 500) res2 <- get.pi.typed.permute(x, 1, 2, 4, 0, 500) - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975))), - equals(c(0.25,0.75))) - expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975))), - equals(c(0.25,0.75))) + expect_that(coxed::bca(as.numeric(res[1,]), conf.level = 0.95), + equals(c(0.25,1))) + expect_that(coxed::bca(as.numeric(res2[1,]), conf.level = 0.95), + equals(c(1/3,1))) }) - test_that ("fails nicely if x and y column names are not provided", { x<-cbind(rep(c(1,2),500), a=runif(1000,0,100), b=runif(1000,0,100)) @@ -74,83 +73,3 @@ test_that ("fails nicely if x and y column names are not provided", { }) - - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND -## test_that("get.pi.permute cis enclose get.pi when no clustering exists", -## { -## set.seed(787) - -## x<-cbind(rep(c(1,2),250), x=runif(500,0,100), y=runif(500,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## #plot(x[,"x"],x[,"y"], col=x[,"type"]) - -## res <- get.pi.permute(x, test, seq(10,100,10), seq(0,90,10), 300) -## res2 <- get.pi(x, test, seq(10,100,10), seq(0,90,10)) - -## for (i in 1:10) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## print(res2[i]) -## print(tmp) -## expect_that(res2[i]>=tmp[1], is_true()) -## expect_that(res2[i]<=tmp[2], is_true()) -## } -## }) - -## test_that("get.pi.permute cis do not enclose get.pi at extremes when no clustering exists", -## { -## set.seed(787) - -## #first generate 200 random uniform points -## x<-cbind(1, x=runif(200,0,100), y=runif(200,0,100)) -## colnames(x) <-c("type","x","y") - -## #add a seed point -## x<-rbind(x,c(2,50,50)) - -## #generate 200 normally distibuted points around this -## x<-rbind(x,cbind(3,rnorm(200,50,20),rnorm(200,50,20))) - -## test <- function(a,b) { -## if (a[1] != 2) return(3) -## if (b[1] == 3) return(1) -## return(2) -## } - -## res <- get.pi.permute(x,test,seq(10,50,10), seq(0,40,10), 200) -## res2 <- get.pi(x,test,seq(10,50,10), seq(0,40,10)) - -## #print(res) -## #print(res2) - -## for (i in c(1,5)) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## expect_that((res2[i]>=tmp[1]) & (res2[i]<=tmp[2]) , -## is_false()) -## } - - -## res <- get.pi.typed.permute(x,2,3,seq(10,50,10), -## seq(0,40,10), 100) - -## for (i in c(1,5)) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## #print(res2[i]) -## #print(tmp) -## expect_that((res2[i]>=tmp[1]) & (res2[i]<=tmp[2]) , -## is_false()) -## } - - -## }) - - diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index d106b83..fad4831 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -38,7 +38,8 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { res <- get.tau.bootstrap(x, test, 1.5, 0.1, 500)[,-(1:2)] res2 <- get.tau.typed.bootstrap(x, 1,2, 1.5, 0.1, 500)[,-(1:2)] - #should have 95% CI of 1,1 + #should have 95% CI of 1,1. quantile() method used as coxed::bca() breaks + # down under Inf conditions expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) @@ -51,7 +52,8 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { res2 <- get.tau.typed.bootstrap(x, 1,2, 1.5, 0.1, 500, comparison.type="independent")[,-(1:2)] - #should have 95% CI of 1,1 + #should have 95% CI of 1,1. quantile() method used as coxed::bca() breaks + # down under Inf conditions expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) @@ -79,6 +81,7 @@ test_that("performs correctly for test case 2 (points on a line) - representativ res <- get.tau.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500)[,-(1:2)] res2 <- get.tau.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500)[,-(1:2)] + expect_that(median(as.numeric(res[1,]), na.rm=T), equals(2)) expect_that(median(as.numeric(res[2,]), na.rm=T), equals(1)) expect_that(median(as.numeric(res[3,]), na.rm=T), equals(0)) @@ -88,7 +91,8 @@ test_that("performs correctly for test case 2 (points on a line) - representativ expect_that(median(as.numeric(res2[3,]), na.rm=T), equals(0)) - + # quantile() used over coxed::bca() as latter breaks down under these toy conditions or cannot + # provide the interval required. #FIRST RANGE #max would be only 1 type 2 used and in range = 1/(1/6) = 6...should occur @@ -153,7 +157,8 @@ test_that("performs correctly for test case 2 (points on a line) - independent c expect_that(median(as.numeric(res2[3,]), na.rm=T), equals(0)) - + # quantile() used over coxed::bca() as latter breaks down under these toy conditions or cannot + # provide the interval required. #FIRST RANGE #max would be Inf, occuring most of the time @@ -254,47 +259,3 @@ test_that("fails nicely if x and y column names are not provided", { throws_error("unique x and y columns must be defined")) }) - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND - - -## test_that("CIs calculated from get.tau.bootstrap include the true value", { -## set.seed(777) - -## x<-cbind(rep(c(1,2),250), x=runif(500,0,100), y=runif(500,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## res <- get.tau.ci(x, test, seq(10,100,10), seq(0,90,10), 200) - -## #print(res) - -## expect_that(sum(!(res[1,]1)),equals(0)) - -## #repeat for typed data -## res <- get.tau.typed.bootstrap(x, typeA=1, typeB=1, -## seq(10,100,10), seq(0,90,10), 200) - -## ci <- matrix(nrow=2, ncol=ncol(res)) - -## for (i in 1:ncol(ci)) { -## ci[,i] <- quantile(res[,i], probs=c(0.025, 0.975)) -## } - -## res <- ci - -## expect_that(sum(!(res[1,]1)),equals(0)) - -## }) - diff --git a/inst/tests/test-getthetabootstrap.r b/inst/tests/test-getthetabootstrap.r index 3863fbf..2836a9f 100644 --- a/inst/tests/test-getthetabootstrap.r +++ b/inst/tests/test-getthetabootstrap.r @@ -59,7 +59,8 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { res2 <- get.theta.typed.bootstrap(x, 1,2, 1.5, 0.1, 500)[,-(1:3)] - #should have 95% CI of 0,1 and mean/median of 0.5 + #should have 95% CI of 0,1 and mean/median of 0.5. quantile() method used as coxed::bca() breaks + # down under Inf conditions expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), equals(c(0,Inf))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), @@ -82,7 +83,8 @@ test_that("performs correctly for test case 2 (points on a line)", { return(2) } - #the medians for the null distribution should be 1,0.5,0 + #the medians for the null distribution should be 1,0.5,0. quantile() method used as + #coxed::bca() breaks down under Inf conditions res <- get.theta.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:3)] res2 <- get.theta.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:3)] From 5ed7d42e8c96a0bbcb08f784fa793506ac5f7611 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 12:51:16 +0000 Subject: [PATCH 26/70] Fix test() and test_file() giving different results by removing context() as advised by the help file of the latter. --- inst/tests/test-getpipermute.r | 12 +++++------- 1 file changed, 5 insertions(+), 7 deletions(-) diff --git a/inst/tests/test-getpipermute.r b/inst/tests/test-getpipermute.r index 5e422f9..73ceb7e 100644 --- a/inst/tests/test-getpipermute.r +++ b/inst/tests/test-getpipermute.r @@ -1,4 +1,4 @@ -context("get.pi.permute") + test_that("get.pi.permute returns appropriate values for test case 1 (equilateral triangle)" ,{ @@ -50,12 +50,10 @@ test_that("get.pi.permute returns appropriate values for test case 2 (points on #without windows the distributions is asymmetric and 95% BCa CI is rather than [0.25,0.75] for # percentile CIs - res <- get.pi.permute(x, test, 4,0, 500) - res2 <- get.pi.typed.permute(x, 1, 2, 4, 0, 500) - expect_that(coxed::bca(as.numeric(res[1,]), conf.level = 0.95), - equals(c(0.25,1))) - expect_that(coxed::bca(as.numeric(res2[1,]), conf.level = 0.95), - equals(c(1/3,1))) + res3 <- get.pi.permute(x, test, 4,0, 500) + res4 <- get.pi.typed.permute(x, 1, 2, 4, 0, 500) + expect_that(coxed::bca(as.numeric(res3[1,]), conf.level = 0.95), equals(c(1/3,1))) + expect_that(coxed::bca(as.numeric(res4[1,]), conf.level = 0.95), equals(c(1/3,1))) }) From 72fd8aa65057e155c979d92744ea725bc69d7038 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 15:24:12 +0000 Subject: [PATCH 27/70] Delete context() on first line as test_that says "We no longer recommend the use of `context()` and instead encourage you to delete it, allowing the context to be autogenerated from the file name." Also delete deprecated text. --- inst/tests/test-getpi.r | 134 ------------------------- inst/tests/test-getpibootstrap.r | 2 - inst/tests/test-getpipermute.r | 25 ++++- inst/tests/test-gettau.r | 97 ------------------ inst/tests/test-gettaubootstrap.r | 2 - inst/tests/test-gettaupermute.r | 83 --------------- inst/tests/test-gettheta.r | 1 - inst/tests/test-getthetabootstrap.r | 2 - inst/tests/test-getthetapermute.r | 2 - inst/tests/test-simulateepidemic.r | 2 - inst/tests/test-thetaweights.r | 2 - inst/tests/test-transdist.r | 2 - inst/tests/test-transdistbootstrapci.r | 2 - inst/tests/test-transdisttemporal.r | 2 - inst/tests/test-wallingateunis.r | 2 - inst/tests/test-wrapperfuncs.r | 2 - 16 files changed, 20 insertions(+), 342 deletions(-) diff --git a/inst/tests/test-getpi.r b/inst/tests/test-getpi.r index 9c83f10..77f07d7 100644 --- a/inst/tests/test-getpi.r +++ b/inst/tests/test-getpi.r @@ -1,4 +1,3 @@ -context("get.pi") test_that("get.pi returns 1 when labels are ignored", { #generate a set of 100 random points even labeled between the two @@ -142,136 +141,3 @@ test_that ("get.pi fails nicely if x and y column names are not provided", { }) - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND -## test_that("get.pi and get.pi.typed have same behavior and both return about .5 when they should", { - -## set.seed(787) - -## #generate a set of 1000 random points even labeled between the two -## x<-cbind(rep(c(1,2),500), x=runif(1000,0,100), y=runif(1000,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## #no lower limit -## res1 <- get.pi(x,test,seq(10,100,10)) -## res2 <- get.pi.typed(x, 1,1, seq(10,100,10)) -## expect_that(res1,equals(res2)) -## expect_that(round(res1,1),equals(rep(.5,10))) -## expect_that(round(res2,1),equals(rep(.5,10))) - - -## #lower limit -## res1 <- get.pi(x,test,seq(10,100,10), seq(0,90,10)) -## res2 <- get.pi.typed(x, 1,1, seq(10,100,10), seq(0,90,10)) -## expect_that(res1,equals(res2)) -## expect_that(round(res1,1),equals(rep(.5,10))) -## expect_that(round(res2,1),equals(rep(.5,10))) -## }) - - -## test_that("get.pi with equality test returns about .5 when points are uniform", -## { -## set.seed(787) - -## #generate a set of 1000 random points even labeled between the two -## x<-cbind(rep(c(1,2),500), x=runif(1000,0,100), y=runif(1000,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1]==b[1]) return(1) -## return(2) -## } - -## #no lower limit -## res1 <- get.pi(x,test,seq(10,100,10)) -## expect_that(round(res1,1),equals(rep(.5,10))) - -## #lower limit -## res1 <- get.pi(x,test,seq(10,100,10), seq(0,90,10)) -## expect_that(round(res1,1),equals(rep(.5,10))) -## }) - - -## test_that("get.pi is montonically decreasing for normally distributed clusters", -## { -## set.seed(787) - -## #first generate 500 random uniform points -## x<-cbind(1, x=runif(500,0,100), y=runif(500,0,100)) -## colnames(x) <-c("type","x","y") - -## #add a seed point -## x<-rbind(x,c(2,50,50)) - -## #generate 500 normally distibuted points around this -## x<-rbind(x,cbind(3,rnorm(1000,50,20),rnorm(1000,50,20))) - -## #check wit get.pi.typed -## res1 <- get.pi.typed(x,2,3,seq(10,50,10), seq(0,40,10)) - -## expect_that(res1[1]>res1[2] & res1[2]>res1[3] & -## res1[3]>res1[4] & res1[4]>res1[5], is_true()) - - -## #do test for not pi version -## test <- function(a,b) { -## if (a[1] != 2) return(3) -## if (b[1] == 3) return(1) -## return(2) -## } - -## res2 <- get.pi(x,test,seq(10,50,10), seq(0,40,10)) - - -## expect_that(res2[1]>res2[2] & res2[2]>res2[3] & -## res2[3]>res2[4] & res2[4]>res2[5], is_true()) -## expect_that(res1,equals(res2)) -## }) - -## test_that("get.pi returns identical results regardless of column order", -## { -## set.seed(787) - -## x<-cbind(rep(c(1,2),500), x=runif(1000,0,100), y=runif(1000,0,100)) -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## res1 <- get.pi(x,test,seq(10,100,10), seq(0,90,10)) - -## test <- function(a,b) { -## if (a[3] != 1) return(3) -## if (b[3] == 1) return(1) -## return(2) -## } - -## res2 <- get.pi(x[,c(3,2,1)],test,seq(10,100,10), seq(0,90,10)) - -## test <- function(a,b) { -## if (a[2] != 1) return(3) -## if (b[2] == 1) return(1) -## return(2) -## } - -## res3 <- get.pi(x[,c(2,1,3)],test,seq(10,100,10), seq(0,90,10)) - -## expect_that(res1, equals(res2)) -## expect_that(res2, equals(res3)) - -## }) - - - diff --git a/inst/tests/test-getpibootstrap.r b/inst/tests/test-getpibootstrap.r index dfe41a0..2f13e19 100644 --- a/inst/tests/test-getpibootstrap.r +++ b/inst/tests/test-getpibootstrap.r @@ -1,5 +1,3 @@ -context("get.pi.bootstrap") - test_that("get.pi.bootstrap runs and returns 1 when it should", { x <- cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) diff --git a/inst/tests/test-getpipermute.r b/inst/tests/test-getpipermute.r index 73ceb7e..36b9e9b 100644 --- a/inst/tests/test-getpipermute.r +++ b/inst/tests/test-getpipermute.r @@ -1,5 +1,3 @@ - - test_that("get.pi.permute returns appropriate values for test case 1 (equilateral triangle)" ,{ x <- rbind(c(1,0,0), c(1,1,0),c(2,.5,sqrt(.75))) @@ -21,7 +19,8 @@ test_that("get.pi.permute returns appropriate values for test case 1 (equilatera }) -test_that("get.pi.permute returns appropriate values for test case 2 (points on a line)" ,{ +test_that("get.pi.permute returns appropriate values for test case 2 (points on a line) with + windows" ,{ x<-rbind(c(1,0,0), c(2,1,0), c(2,-1,0), c(3,2,0), c(2,-2,0), c(3,3,0),c(3,-3,0)) @@ -35,6 +34,7 @@ test_that("get.pi.permute returns appropriate values for test case 2 (points on #the mean of the null distribution should be 0.5 #the 95% CI equals 0,1 with windows + set.seed(seed = 1) res <- get.pi.permute(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:2)] res2 <- get.pi.typed.permute(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 500)[,-(1:2)] @@ -48,8 +48,24 @@ test_that("get.pi.permute returns appropriate values for test case 2 (points on equals(c(0,1))) } +}) + +test_that("get.pi.permute returns appropriate values for test case 2 (points on a line), + no windows" ,{ + x<-rbind(c(1,0,0), c(2,1,0), c(2,-1,0), c(3,2,0), + c(2,-2,0), c(3,3,0),c(3,-3,0)) + + colnames(x) <-c("type","x","y") + + test <- function(a,b) { + if (a[1] != 1) return(3) + if (b[1] == 2) return(1) + return(2) + } + #without windows the distributions is asymmetric and 95% BCa CI is rather than [0.25,0.75] for # percentile CIs + set.seed(seed = 1) res3 <- get.pi.permute(x, test, 4,0, 500) res4 <- get.pi.typed.permute(x, 1, 2, 4, 0, 500) expect_that(coxed::bca(as.numeric(res3[1,]), conf.level = 0.95), equals(c(1/3,1))) @@ -69,5 +85,4 @@ test_that ("fails nicely if x and y column names are not provided", { expect_that(get.pi.permute(x,test,seq(10,50,10), seq(0,40,10),100), throws_error("unique x and y columns must be defined")) -}) - +}) \ No newline at end of file diff --git a/inst/tests/test-gettau.r b/inst/tests/test-gettau.r index ec1c910..2ec6260 100644 --- a/inst/tests/test-gettau.r +++ b/inst/tests/test-gettau.r @@ -1,5 +1,3 @@ -context("get.tau") - test_that("get.tau returns 1 when labels are ignored", { #generate a set of 1000 random points even labeled between the two @@ -177,98 +175,3 @@ test_that ("selection of an invalid comparison type fails nicely", { throws_error("unkown comparison type specified")) }) - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND - - -## test_that("get.tau and get.tau.typed have same behavior and both return about 1 when they should", { -## set.seed(380) - -## #generate a set of 1000 random points even labeled between the two -## x<-cbind(rep(c(1,2),500), x=runif(1000,0,100), y=runif(1000,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## #no lower limit -## res1 <- get.tau(x,test,seq(10,100,10)) -## res2 <- get.tau.typed(x, 1,1, seq(10,100,10)) -## expect_that(res1,equals(res2)) -## expect_that(round(res1,1),equals(rep(1,10))) -## expect_that(round(res2,1),equals(rep(1,10))) - - -## #lower limit -## res1 <- get.tau(x,test,seq(10,100,10), seq(0,90,10)) -## res2 <- get.tau.typed(x, 1,1, seq(10,100,10), seq(0,90,10)) -## expect_that(res1,equals(res2)) -## expect_that(round(res1,1),equals(rep(1,10))) -## expect_that(round(res2,1),equals(rep(1,10))) -## }) - -## test_that("get.tau with equality test returns about .5 when points are uniform", -## { -## set.seed(787) - -## #generate a set of 1000 random points even labeled between the two -## x<-cbind(rep(c(1,2),500), x=runif(1000,0,100), y=runif(1000,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1]==b[1]) return(1) -## return(2) -## } - -## #no lower limit -## res1 <- get.tau(x,test,seq(10,100,10)) -## expect_that(round(res1,1),equals(rep(1,10))) - -## #lower limit -## res1 <- get.tau(x,test,seq(10,100,10), seq(0,90,10)) -## expect_that(round(res1,1),equals(rep(1,10))) -## }) - - -## test_that("get.tau is montonically decreasing for normally distributed clusters", -## { -## set.seed(787) - -## #first generate 500 random uniform points -## x<-cbind(1, x=runif(500,0,100), y=runif(500,0,100)) -## colnames(x) <-c("type","x","y") - -## #add a seed point -## x<-rbind(x,c(2,50,50)) - -## #generate 500 normally distibuted points around this -## x<-rbind(x,cbind(3,rnorm(1000,50,20),rnorm(1000,50,20))) - -## #check wit get.tau.typed -## res1 <- get.tau.typed(x,2,3,seq(10,50,10), seq(0,40,10)) - -## expect_that(res1[1]>res1[2] & res1[2]>res1[3] & -## res1[3]>res1[4] & res1[4]>res1[5], is_true()) - - -## #do -## test <- function(a,b) { -## if (a[1] != 2) return(3) -## if (b[1] == 3) return(1) -## return(2) -## } - -## res2 <- get.tau(x,test,seq(10,50,10), seq(0,40,10)) - - -## expect_that(res2[1]>res2[2] & res2[2]>res2[3] & -## res2[3]>res2[4] & res2[4]>res2[5], is_true()) -## expect_that(res1,equals(res2)) -## }) - diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index fad4831..37dd76c 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -1,5 +1,3 @@ -context("get.tau.bootstrap") - test_that("get.tau.bootstrap runs and returs 1 when it should", { x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) diff --git a/inst/tests/test-gettaupermute.r b/inst/tests/test-gettaupermute.r index 1f1cccc..48adc6f 100644 --- a/inst/tests/test-gettaupermute.r +++ b/inst/tests/test-gettaupermute.r @@ -1,5 +1,3 @@ -context("get.tau.permute") - test_that("get.tau.permute returns appropriate values for test case 1 (equilateral triangle)" ,{ x <- rbind(c(1,0,0), c(1,1,0),c(2,.5,sqrt(.75))) @@ -97,84 +95,3 @@ test_that ("fails nicely if x and y column names are not provided", { }) - -##################DEPRECATED TESTS...TAKE TO LONG...NOW USING SMALLER CANONICAL -##################TESTS THAT HAVE VALUES THAT CAN BE WORKED OUT BY HAND -## test_that("get.tau.permute cis enclose get.tau when no clustering exists", -## { -## set.seed(788) - -## x<-cbind(rep(c(1,2),250), x=runif(500,0,100), y=runif(500,0,100)) - -## colnames(x) <-c("type","x","y") - -## test <- function(a,b) { -## if (a[1] != 1) return(3) -## if (b[1] == 1) return(1) -## return(2) -## } - -## #plot(x[,"x"],x[,"y"], col=x[,"type"]) - -## res <- get.tau.permute(x, test, seq(10,100,10), seq(0,90,10), 200) -## res2 <- get.tau(x, test, seq(10,100,10), seq(0,90,10)) - -## for (i in 1:10) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## #print(res2[i]) -## #print(tmp) -## expect_that(res2[i]>=tmp[1], is_true()) -## expect_that(res2[i]<=tmp[2], is_true()) -## } -## }) - -## test_that("get.tau.permute cis do not enclose get.tau at extremes when no clustering exists", -## { -## set.seed(788) - -## #first generate 200 random uniform points -## x<-cbind(1, x=runif(300,0,100), y=runif(300,0,100)) -## colnames(x) <-c("type","x","y") - -## #add a seed point -## x<-rbind(x,c(2,50,50)) - -## #generate 200 normally distibuted points around this -## x<-rbind(x,cbind(3,rnorm(300,50,20),rnorm(300,50,20))) - -## test <- function(a,b) { -## if (a[1] != 2) return(3) -## if (b[1] == 3) return(1) -## return(2) -## } - -## ## res <- get.tau.permute(x,test,seq(10,50,10), seq(0,40,10), 200) -## res2 <- get.tau(x,test,seq(10,50,10), seq(0,40,10)) - - -## for (i in c(1,5)) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## #print(tmp) -## #print(res2[i]) -## expect_that((res2[i]>=tmp[1]) & (res2[i]<=tmp[2]) , -## is_false()) -## } - - - -## res <- get.tau.typed.permute(x,2,3,seq(10,50,10), -## seq(0,40,10), 100) - - -## for (i in c(1,5)) { -## tmp <- quantile(res[,i], probs=c(0.025, .975), na.rm=T) -## #print(res2[i]) -## #print(tmp) -## expect_that((res2[i]>=tmp[1]) & (res2[i]<=tmp[2]) , -## is_false()) -## } - - -## }) - - diff --git a/inst/tests/test-gettheta.r b/inst/tests/test-gettheta.r index 264ca80..03423df 100644 --- a/inst/tests/test-gettheta.r +++ b/inst/tests/test-gettheta.r @@ -1,4 +1,3 @@ -context("get.theta") test_that("get.theta returns Inf when all relations are 1", { #Would throwing an error be better? #generate a set of 100 random points even labeled between the two x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) diff --git a/inst/tests/test-getthetabootstrap.r b/inst/tests/test-getthetabootstrap.r index 2836a9f..1d35990 100644 --- a/inst/tests/test-getthetabootstrap.r +++ b/inst/tests/test-getthetabootstrap.r @@ -1,5 +1,3 @@ -context("get.theta.bootstrap") - test_that("get.theta.bootstrap runs and returns Inf when all relations are 1", { x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) diff --git a/inst/tests/test-getthetapermute.r b/inst/tests/test-getthetapermute.r index f3272a3..e5bf9a8 100644 --- a/inst/tests/test-getthetapermute.r +++ b/inst/tests/test-getthetapermute.r @@ -1,5 +1,3 @@ -context("get.theta.permute") - test_that("get.theta.permute returns appropriate values for test case 1 (equilateral triangle)" ,{ x <- rbind(c(1,0,0), c(1,1,0),c(2,.5,sqrt(.75))) diff --git a/inst/tests/test-simulateepidemic.r b/inst/tests/test-simulateepidemic.r index a2232a1..ae1fdcd 100644 --- a/inst/tests/test-simulateepidemic.r +++ b/inst/tests/test-simulateepidemic.r @@ -1,5 +1,3 @@ -context("sim.epidemic") - test_that("Plausible parameter values produce simulations: R", { for(i in seq(1, 2, 0.25)) { diff --git a/inst/tests/test-thetaweights.r b/inst/tests/test-thetaweights.r index 66c20c7..9e2b6c0 100644 --- a/inst/tests/test-thetaweights.r +++ b/inst/tests/test-thetaweights.r @@ -1,5 +1,3 @@ -context("theta weights") - test_that("Correct array for theta values is returned", { case.times <- c(1,2,2,3,3) diff --git a/inst/tests/test-transdist.r b/inst/tests/test-transdist.r index 1803190..95beb34 100644 --- a/inst/tests/test-transdist.r +++ b/inst/tests/test-transdist.r @@ -1,5 +1,3 @@ -context("estimate transdist") - test_that("Data checks performed", { set.seed(1) diff --git a/inst/tests/test-transdistbootstrapci.r b/inst/tests/test-transdistbootstrapci.r index 0efde22..cf8b59a 100644 --- a/inst/tests/test-transdistbootstrapci.r +++ b/inst/tests/test-transdistbootstrapci.r @@ -1,5 +1,3 @@ -context("estimate transdist bootstraps") - test_that("Data checks performed", { set.seed(1) diff --git a/inst/tests/test-transdisttemporal.r b/inst/tests/test-transdisttemporal.r index 5175029..e6988b1 100644 --- a/inst/tests/test-transdisttemporal.r +++ b/inst/tests/test-transdisttemporal.r @@ -1,5 +1,3 @@ -context("estimate transdist temporal") - test_that("Data checks performed", { set.seed(1) diff --git a/inst/tests/test-wallingateunis.r b/inst/tests/test-wallingateunis.r index fdedf32..f82b64e 100644 --- a/inst/tests/test-wallingateunis.r +++ b/inst/tests/test-wallingateunis.r @@ -1,5 +1,3 @@ -context("Wallinga-Teunis") - test_that("Basic case time WT weights are calculated correctly", { # Toy example from paper diff --git a/inst/tests/test-wrapperfuncs.r b/inst/tests/test-wrapperfuncs.r index c09ea57..5d270d9 100644 --- a/inst/tests/test-wrapperfuncs.r +++ b/inst/tests/test-wrapperfuncs.r @@ -1,5 +1,3 @@ -context("crossK and crossPCF wrapper functions") - test_that("Data checks performed", { msg <- "epi.data must be a numeric matrix" From 9373cd61dd2ba0f0bdf64e05ff8a439ac8b3c08b Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 15:27:04 +0000 Subject: [PATCH 28/70] deprecated is_true replacement --- inst/tests/test-gettaubootstrap.r | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index 37dd76c..94502a0 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -110,9 +110,9 @@ test_that("performs correctly for test case 2 (points on a line) - representativ equals(0)) expect_that(as.numeric(quantile(res[2,], probs=c(.99), na.rm=T))<6, - is_true()) + expect_true()) expect_that(as.numeric(quantile(res2[2,], probs=c(.99), na.rm=T))<6, - is_true()) + expect_true()) @@ -176,9 +176,9 @@ test_that("performs correctly for test case 2 (points on a line) - independent c equals(0)) expect_that(as.numeric(quantile(res[2,], probs=c(.7), na.rm=T))!=Inf, - is_true()) + expect_true()) expect_that(as.numeric(quantile(res2[2,], probs=c(.7), na.rm=T))!=Inf, - is_true()) + expect_true()) From 855c10b54ded7db25e80bce0533ce66f1d448347 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 15:37:23 +0000 Subject: [PATCH 29/70] Fix expect_true bug --- inst/tests/test-gettaubootstrap.r | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index 94502a0..771c2ac 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -109,12 +109,8 @@ test_that("performs correctly for test case 2 (points on a line) - representativ expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) - expect_that(as.numeric(quantile(res[2,], probs=c(.99), na.rm=T))<6, - expect_true()) - expect_that(as.numeric(quantile(res2[2,], probs=c(.99), na.rm=T))<6, - expect_true()) - - + expect_true(as.numeric(quantile(res[2,], probs=c(.99), na.rm=T))<6) + expect_true(as.numeric(quantile(res2[2,], probs=c(.99), na.rm=T))<6) #THIRD RANGE #Should be determinsitically 0 or NaN @@ -175,10 +171,8 @@ test_that("performs correctly for test case 2 (points on a line) - independent c expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) - expect_that(as.numeric(quantile(res[2,], probs=c(.7), na.rm=T))!=Inf, - expect_true()) - expect_that(as.numeric(quantile(res2[2,], probs=c(.7), na.rm=T))!=Inf, - expect_true()) + expect_true(as.numeric(quantile(res[2,], probs=c(.7), na.rm=T))!=Inf) + expect_true(as.numeric(quantile(res2[2,], probs=c(.7), na.rm=T))!=Inf) From b7126a4ef6bc0e82d1baf6b2ed8543cb7d056cc4 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 19:32:08 +0000 Subject: [PATCH 30/70] Incorporate tau class --- R/spatialfuncs.r | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 86bb608..4a7a859 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -906,8 +906,10 @@ get.tau <- function(posmat, ycol) if (data.frame == FALSE) { + class(rc) <- "tau" return(rc) } else if (data.frame == TRUE) { + class(rc) <- "tau" return(data.frame(r.low=r.low, r=r, tau=rc)) } } From e40259883099b4ba640a187d855d3dbf3050d5c4 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 20:50:03 +0000 Subject: [PATCH 31/70] Fix bugs assoc with new tau class. --- R/spatialfuncs.r | 7 ++++--- inst/tests/test-gettau.r | 6 +++--- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 4a7a859..1652b4d 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -892,7 +892,7 @@ get.tau <- function(posmat, } else if (comparison.type == "independent") { comp.type.int <- 1 } else { - stop("unkown comparison type specified") + stop("unknown comparison.type specified") } rc <- .Call("get_tau", @@ -909,8 +909,9 @@ get.tau <- function(posmat, class(rc) <- "tau" return(rc) } else if (data.frame == TRUE) { + rc = data.frame(r.low=r.low, r=r, tau.pt.est=rc) class(rc) <- "tau" - return(data.frame(r.low=r.low, r=r, tau=rc)) + return(rc) } } @@ -955,7 +956,7 @@ get.tau.typed <- function(posmat, } else if (comparison.type == "independent") { comp.type.int <- 1 } else { - stop("unkown comparison type specified") + stop("unknown comparison.type specified") } rc <- .C("get_tau_typed", diff --git a/inst/tests/test-gettau.r b/inst/tests/test-gettau.r index 2ec6260..c0836f4 100644 --- a/inst/tests/test-gettau.r +++ b/inst/tests/test-gettau.r @@ -9,7 +9,7 @@ test_that("get.tau returns 1 when labels are ignored", { #######FIRST WITH REPRESENTATIVE SAMPLE ASSUMED #with no lower limit - res <- get.tau(x,test,seq(10,100,10))$tau + res <- get.tau(x,test,seq(10,100,10))$tau.pt.est expect_that(res,equals(rep(1,10))) #with lower and upper limit @@ -170,8 +170,8 @@ test_that ("selection of an invalid comparison type fails nicely", { expect_that( get.tau(x, test, c(1.5,2.5,Inf), c(0,1.5,2.5), comparison.type="foobar"), - throws_error("unkown comparison type specified")) + throws_error("unknown comparison.type specified")) expect_that( get.tau.typed(x, 1, 2, c(1.5,2.5,1000), c(0,1.5,2.5), comparison.type="foobar"), - throws_error("unkown comparison type specified")) + throws_error("unknown comparison.type specified")) }) From 5c1d680435b7acb317735766644f9fb4f3bb063e Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 20:55:04 +0000 Subject: [PATCH 32/70] Updates --- NEWS.md | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 796b8ff..6c1ba57 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,16 +1,19 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) +Most of these changes concern the tau statistic functions: * `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to compute BCa (bias-corrected and accelerated) confidence intervals (CIs) rather than percentile. Note this will result in a change in your results versus previous versions if if computing CIs. `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. At times the `coxed::bca()` method gives slightly different test results if it is applied to asymmetric distributions. -* NEWS.md file added +* `get.tau()` returns a new S3 `tau` class * CITATION file added * README.md formatting updated +* `get.tau$tau` renamed to `get.tau$tau.pt.est` * Deprecated tests that were previously commented out in `inst/tests/` as a warning of removal have not been removed. +* NEWS.md file added, but as you're reading this you probably knew that already ;) ## Bug fixes (top of list are most important) From c518ed7c1026c5c4056dc2a4385d46abb055a80c Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 21:05:50 +0000 Subject: [PATCH 33/70] plot.tau() method added --- R/spatialfuncs.r | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 1652b4d..006f1fb 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -915,6 +915,11 @@ get.tau <- function(posmat, } } +print.tau <- function(x, ...) +{ + cat("Call:\n") + print(x$call) +} ##' Optimized version of \code{get.tau} for typed data ##' From 1c53c396914cc7ba5fc0ec4537ed0667fb7173f7 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 21:06:39 +0000 Subject: [PATCH 34/70] Correction to previous commit. It was print.tau that was added, not plot.tau! --- R/spatialfuncs.r | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 006f1fb..234935b 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -893,7 +893,7 @@ get.tau <- function(posmat, comp.type.int <- 1 } else { stop("unknown comparison.type specified") - } + } rc <- .Call("get_tau", posmat, From 3294b6eae34ebeaa8023edd67822940886400033 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 17 Mar 2020 22:04:50 +0000 Subject: [PATCH 35/70] U-turn: print.tau not required as print() sufficient --- R/spatialfuncs.r | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 234935b..97ead10 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -915,10 +915,21 @@ get.tau <- function(posmat, } } -print.tau <- function(x, ...) +plot.tau <- function(x, r.mid = TRUE, log = "n", ...) { - cat("Call:\n") - print(x$call) + X = x + if(r.mid==TRUE){ + x = 0.5*(X$r.low + X$r) + } + else{ + x = X$r + } + logy = ifelse(log=="n","n",ifelse(log=="y", "y", "n")) + plot(x,X$tau.pt.est,ylim=c(min(X$tau.pt.est, na.rm = TRUE),max(X$tau.pt.est)),log=logy, + cex.axis=1.,col="blue", + xlab="Distance (m)",ylab="Tau",cex.main=1,lwd=2,type="l",las=1,cex.axis=1) + abline(h=1,lty=2) + legend("topright",legend=c("Tau point estimate", lwd=2, col="blue", lty=1,bty="n")) } ##' Optimized version of \code{get.tau} for typed data From d5b4d492729865de752d1a1f6846cb571c33aab2 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 19 Mar 2020 14:11:23 +0000 Subject: [PATCH 36/70] plot.tau: axis labels, legend, midpoint/endpoint, units. --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 10 +++++++++- R/spatialfuncs.r | 44 +++++++++++++++++++++++++++++++++++--------- 4 files changed, 46 insertions(+), 11 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 85f1f1c..d9a9b6c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,7 @@ Description: Implements various novel and standard spread of infectious disease. RoxygenNote: 7.0.2 Encoding: UTF-8 -Imports: igraph, spatstat, coxed +Imports: igraph, spatstat, coxed, latex2exp Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index a00b806..29bb68d 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -34,6 +34,7 @@ export(get.tau.typed) export(get.tau.ci) export(get.tau.typed.bootstrap) export(get.tau.typed.permute) +export(plot.tau) export(sim.epidemic) export(sim.plot) export(est.wt.matrix) diff --git a/NEWS.md b/NEWS.md index 6c1ba57..1bfbe36 100644 --- a/NEWS.md +++ b/NEWS.md @@ -8,7 +8,15 @@ Most of these changes concern the tau statistic functions: `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. At times the `coxed::bca()` method gives slightly different test results if it is applied to asymmetric distributions. -* `get.tau()` returns a new S3 `tau` class +* `get.tau()` returns a new S3 `tau` class with special methods for: + * `plot()` provides a tau-distance graph with an option for pointwise confidence intervals for + a visual indication of spatiotemporal clustering. In this version we use error bars as default, to + remind the reader that this graph should not be used as a graphical hypothesis test for the whole + distance range observed (CITE!). It is only suitable for the purpose of a graphical hypothesis + test if a specific distance band is decided before looking at the graph to see if it encloses + tau=1. + +that follow current best-practice mentioned in a recent review of the tau statistic. * CITATION file added * README.md formatting updated * `get.tau$tau` renamed to `get.tau$tau.pt.est` diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 97ead10..5be2ad7 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -915,21 +915,47 @@ get.tau <- function(posmat, } } -plot.tau <- function(x, r.mid = TRUE, log = "n", ...) +plot.tau <- function(x, r.mid = TRUE, ...) { - X = x if(r.mid==TRUE){ - x = 0.5*(X$r.low + X$r) + r.end = 0.5*(x$r.low + x$r) + midorend = "at distance band midpoint" + xlim = c(0,(max(r.end)*1.01)) } else{ - x = X$r + r.end = x$r + midorend = "at distance band endpoint" + xlim = c(0,(max(x$r)*1.01)) } - logy = ifelse(log=="n","n",ifelse(log=="y", "y", "n")) - plot(x,X$tau.pt.est,ylim=c(min(X$tau.pt.est, na.rm = TRUE),max(X$tau.pt.est)),log=logy, - cex.axis=1.,col="blue", - xlab="Distance (m)",ylab="Tau",cex.main=1,lwd=2,type="l",las=1,cex.axis=1) + + # identify if the lower bound of each distance band contains zero or not, + # and label graph appropriately, with correct units if provided + if(!is.null(attr(x$r.low, "units")) & !is.null(attr(x$r, "units")) & + identical(attr(x$r.low, "units"), attr(x$r, "units"))){ + unitslabel = attr(x$r.low, "units") + } + else{ + unitslabel = "" + } + + if(all(x$r.low==0)){ + xlab = bquote("Distance [0," * d[m] * ") from an average case (" * .(unitslabel) * ")") + } + else{ + xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") + } + + plot(x = r.end, y = x$tau.pt.est, + xlim=xlim, + ylim=range(x$tau.pt.est, na.rm = TRUE)+diff(range(x$tau.pt.est, na.rm = TRUE))*c(-0.05,0.05), + cex.axis=1.,col="black", xlab=xlab, + ylab="Tau", + cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) abline(h=1,lty=2) - legend("topright",legend=c("Tau point estimate", lwd=2, col="blue", lty=1,bty="n")) + legend("topright", + legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), + col="black", pch=16 + ) } ##' Optimized version of \code{get.tau} for typed data From 84068b1a9accd42d157543ab768141ba8f0a2692 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 19 Mar 2020 21:24:19 +0000 Subject: [PATCH 37/70] plot.tau(): CIs added. --- R/spatialfuncs.r | 23 ++++++++++++++++------- inst/tests/test-gettaubootstrap.r | 18 +++++++++--------- 2 files changed, 25 insertions(+), 16 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 5be2ad7..8e81397 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -907,16 +907,22 @@ get.tau <- function(posmat, if (data.frame == FALSE) { class(rc) <- "tau" + attr(rc, "comparison.type") = comparison.type return(rc) } else if (data.frame == TRUE) { rc = data.frame(r.low=r.low, r=r, tau.pt.est=rc) class(rc) <- "tau" + attr(rc, "comparison.type") = comparison.type return(rc) } } -plot.tau <- function(x, r.mid = TRUE, ...) +plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, ...) { + if(!is.null(ptwise.CI)){ + stopifnot(class(ptwise.CI)=="tauCI") + } + if(r.mid==TRUE){ r.end = 0.5*(x$r.low + x$r) midorend = "at distance band midpoint" @@ -951,6 +957,9 @@ plot.tau <- function(x, r.mid = TRUE, ...) cex.axis=1.,col="black", xlab=xlab, ylab="Tau", cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) + if(!is.null(ptwise.CI)){ + arrows(r.end, ptwise.CI$ci.low, r.end, ptwise.CI$ci.high, length = 0.04, angle = 90, code = 3) + } abline(h=1,lty=2) legend("topright", legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), @@ -1061,13 +1070,13 @@ get.tau.ci <- function(posmat, rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { + class(rc) <- "tauCI" return(rc) } else if (data.frame == TRUE) { - return(data.frame(r.low=r.low, - r=r, - pt.est=get.tau(posmat, fun, r, r.low)$tau, - ci.low=rc[1,], - ci.high=rc[2,])) + rc = data.frame(r.low=r.low, r=r, pt.est=get.tau(posmat, fun, r, r.low)$tau, + ci.low=rc[1,], ci.high=rc[2,]) + class(rc) <- "tauCI" + return(rc) } } @@ -1182,7 +1191,7 @@ get.tau.typed.bootstrap <- function(posmat, } else if (comparison.type == "independent") { comp.type.int <- 1 } else { - stop("unkown comparison type specified") + stop("unknown comparison type specified") } rc <- matrix(nrow=boot.iter, ncol=length(r)) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index 771c2ac..eaba2e2 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -203,15 +203,15 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { set.seed(787) ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type = "representative", - ci.level = 0.95)[,-(1:3)] + ci.level = 0.95, data.frame = FALSE) - expect_that(as.numeric(ci1[1,]), + expect_that(as.numeric(t(ci1)[1,]), equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[2,]), + expect_that(as.numeric(t(ci1)[2,]), equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[3,]), + expect_that(as.numeric(t(ci1)[3,]), equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) ### INDEPENDENT @@ -220,16 +220,16 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { comparison.type="independent")[,-(1:2)] set.seed(787) - ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, - comparison.type="independent")[,-(1:3)] + ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type="independent", + data.frame = FALSE) - expect_that(as.numeric(ci1[1,]), + expect_that(as.numeric(t(ci1)[1,]), equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[2,]), + expect_that(as.numeric(t(ci1)[2,]), equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) - expect_that(as.numeric(ci1[3,]), + expect_that(as.numeric(t(ci1)[3,]), equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) }) From 6b7dd2b3fc1cd60874664f5a86547c6ab5c7a753 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Mon, 23 Mar 2020 12:42:13 +0000 Subject: [PATCH 38/70] Implement get.tau.GET. Note plot method embedded within. Now needs to be separated. --- DESCRIPTION | 2 +- NAMESPACE | 3 +++ NEWS.md | 9 ++++++++- R/spatialfuncs.r | 45 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 57 insertions(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d9a9b6c..1a3b5c0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,7 @@ Description: Implements various novel and standard spread of infectious disease. RoxygenNote: 7.0.2 Encoding: UTF-8 -Imports: igraph, spatstat, coxed, latex2exp +Imports: igraph, spatstat, coxed, GET, scales Depends: doParallel, foreach, parallel, R (>= 2.10) Suggests: knitr, rmarkdown, testthat VignetteBuilder: knitr diff --git a/NAMESPACE b/NAMESPACE index 29bb68d..04247e6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,8 @@ import("doParallel") import("foreach") import("stats") import("graphics") +import("scales") +import("GET") importFrom("igraph", "graph.data.frame") # for get.transdist.theta() importFrom("igraph", "shortest.paths") # for get.transdist.theta() importFrom("igraph", "E") # for get.transdist.theta() @@ -23,6 +25,7 @@ export(get.theta.bootstrap) export(get.theta.permute) export(get.tau) export(get.tau.bootstrap) +export(get.tau.GET) export(get.tau.permute) export(get.pi.typed) export(get.pi.typed.bootstrap) diff --git a/NEWS.md b/NEWS.md index 1bfbe36..6f94c37 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,9 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) -Most of these changes concern the tau statistic functions: +These changes mostly concern the tau statistic functions. + +Specific changes * `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to compute BCa (bias-corrected and accelerated) confidence intervals (CIs) rather than percentile. Note this will result in a change in your results versus previous versions if if computing CIs. @@ -24,4 +26,9 @@ that follow current best-practice mentioned in a recent review of the tau statis have not been removed. * NEWS.md file added, but as you're reading this you probably knew that already ;) +Generic changes: +* ability to have distance units defined and automatically plotted on graph +* documentation updated, with rationale for use with linked references to recent literature which has +informed this change. + ## Bug fixes (top of list are most important) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 8e81397..77073cc 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -917,6 +917,51 @@ get.tau <- function(posmat, } } +get.tau.GET <- function(posmat, fun, r, r.low, permutations = 10, comparison.type){ + get.tau = IDSpatialStats::get.tau(posmat = posmat, fun = fun, r = r, r.low = r.low, comparison.type = comparison.type, data.frame = FALSE) + tau.permute = IDSpatialStats::get.tau.permute(posmat = posmat, fun = fun, r = r, r.low = r.low, permutations = permutations, comparison.type = comparison.type, data.frame = FALSE) + curveset = GET::create_curve_set(list(r = r, obs = as.numeric(get.tau), sim_m = t(tau.permute))) + GET.res = GET::global_envelope_test(curve_sets = curveset, type = "rank", alpha = 0.05, + alternative = c("two.sided"), ties = "erl", probs = c(0.025, 0.975), quantile.type = 7, + central = "median") + if(all(r.low==0)){ + xlab = bquote("Distance [0," * d[m] * ") from an average case (" * .(unitslabel) * ")") + } else { + xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") + } + plot(NULL, xlim = c(0,max(r, na.rm = TRUE)), ylim = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + ylab = "Tau", xlab = xlab, lwd = 4, cex.lab = 1.5) + + for (i in 1:permutations) { + lines(r, tau.permute[i,], col = scales::alpha("grey", alpha = 0.3), lwd = 1) + } + yaxis.range = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)) + yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) + yaxis.lab = sort(yaxis.lab) + yaxis.lab = round(yaxis.lab,digits = 1) + yaxis.lab = unique(yaxis.lab) # prevents more than one 1.0 value + yaxis.lab[which(yaxis.lab==1)] = round(yaxis.lab[which(yaxis.lab==1)],digits = 0) + axis(2, las=1, at=yaxis.lab, labels = as.character(yaxis.lab), lwd = 1) + lines(GET.res$r, GET.res$lo, col = "slategrey", lwd = 3) + lines(GET.res$r, GET.res$hi, col = "slategrey", lwd = 3) + lines(GET.res$r, GET.res$central, col = "red", lwd = 3) + lines(GET.res$r, GET.res$obs, lwd = 4) + axis(1, lwd = 1) + abline(h=1, lty = 2, lwd = 4) + legend("topright", legend=c(as.expression(bquote(~ hat(tau) ~ "point estimate")), + "95% global envelope",as.expression(bquote("simulations of " ~ H[0])), + "median simulation", + as.expression(bquote(~ tau == 1)) ), + col=c("black", "slategrey", "grey", "red", "black"), + lty=c(1,1,1,1,2), cex=1.05, yjust = 0.5, lwd = 6) + par(xpd = TRUE) + pint.lo = round(attr(GET.res,"p_interval"), digits = 3)[1] + pint.hi = round(attr(GET.res,"p_interval"), digits = 3)[2] + pint.x = 0.5 * max(r, na.rm = TRUE) + pint.y = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))) + text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) +} + plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, ...) { if(!is.null(ptwise.CI)){ From f7c93aef60b31d49d3d9f569c50c7edf068852c7 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Mon, 23 Mar 2020 17:46:35 +0000 Subject: [PATCH 39/70] Add commented out code ready for get.tau.D.param.est. Next stage is to create a new branch. --- NAMESPACE | 1 + NEWS.md | 3 +- R/spatialfuncs.r | 178 +++++++++++++++++++++++++++++++++++++---------- 3 files changed, 144 insertions(+), 38 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 04247e6..490dbd0 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -26,6 +26,7 @@ export(get.theta.permute) export(get.tau) export(get.tau.bootstrap) export(get.tau.GET) +export(get.tau.D.param.est) export(get.tau.permute) export(get.pi.typed) export(get.pi.typed.bootstrap) diff --git a/NEWS.md b/NEWS.md index 6f94c37..4e201e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ # IDSpatialStats 1.0.0 ## Changes (top of list are most important) -These changes mostly concern the tau statistic functions. +These changes mostly concern the tau statistic functions. These are big changes and we may have +unwittingly introduced bugs. Please send us a reproducible example if you find one. Specific changes * `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 77073cc..7aaae93 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -917,56 +917,124 @@ get.tau <- function(posmat, } } -get.tau.GET <- function(posmat, fun, r, r.low, permutations = 10, comparison.type){ +get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.type){ get.tau = IDSpatialStats::get.tau(posmat = posmat, fun = fun, r = r, r.low = r.low, comparison.type = comparison.type, data.frame = FALSE) tau.permute = IDSpatialStats::get.tau.permute(posmat = posmat, fun = fun, r = r, r.low = r.low, permutations = permutations, comparison.type = comparison.type, data.frame = FALSE) curveset = GET::create_curve_set(list(r = r, obs = as.numeric(get.tau), sim_m = t(tau.permute))) GET.res = GET::global_envelope_test(curve_sets = curveset, type = "rank", alpha = 0.05, alternative = c("two.sided"), ties = "erl", probs = c(0.025, 0.975), quantile.type = 7, central = "median") - if(all(r.low==0)){ - xlab = bquote("Distance [0," * d[m] * ") from an average case (" * .(unitslabel) * ")") - } else { - xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") - } - plot(NULL, xlim = c(0,max(r, na.rm = TRUE)), ylim = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", - ylab = "Tau", xlab = xlab, lwd = 4, cex.lab = 1.5) + GET.res$tau.permute = tau.permute + class(GET.res) <- "tauGET" + return(GET.res) +} + +get.tau.D.param.est <- function(){ + + # ciIntercept <- function(n.sim, mid.set, tau.sim) { + # j.max = length(mid.set) + # # now define d.envelope + # alwaysabove1 = 0 + # d.envelope = NULL + # for (i in 1:n.sim) { + # j = 1 + # if(tau.sim[i,j] > 1){ # else ignore simulation as starting from below tau = 1 + # stillabove1 = T + # while (stillabove1 & (j < j.max)) { + # j = j + 1 + # if(tau.sim[i,j] <= 1){ # else it stays above tau = 1 until the next j is tested + # stillabove1 = F + # root.tau1 = ((1-tau.sim[i,(j-1)])*(mid.set[j]-mid.set[j-1])/ + # (tau.sim[i,j]-tau.sim[i,(j-1)]))+mid.set[j-1] + # d.envelope = c(d.envelope, root.tau1) + # } + # } + # if(stillabove1 & j==j.max){ + # alwaysabove1 = alwaysabove1 + 1 + # } + # } + # } + # # print warnings as if the value is much below 100% then a CI can't be constructed as + # # it has not been drawn from a random sample. + # print(paste0("sims cross tau = 1 from above = ",length(d.envelope)/n.sim*100,"%")) + # print(paste0("alwaysabove1 = ",alwaysabove1/n.sim*100,"%")) + # return(d.envelope) + # } + # + + #tauCI2500lohv2 = summonTauBstraplohv2(X.region = as.matrix(hag.dat), r.min = r.min, + #r.max = r.max, bootiters = 2500, T1 = 0, T2 = 14) + #d.envelope2500lohv2 = ciIntercept(2500, mid.set = r.mid, tau.sim = tauCI2500lohv2) + + # + # quantile(d.envelope100, probs = c(0.025,0.975)) + # + # # compute where on d-axis the point estimate intercepts tau(d) = 1---- + # firstbelow1 = which(tau.hagg < 1)[1] # when does the point estimate first fall below tau=1 + # y1 = tau.hagg[firstbelow1-1] + # y2 = tau.hagg[firstbelow1] + # x1 = r.mid[firstbelow1-1] + # x2 = r.mid[firstbelow1] + # m = (y2-y1)/(x2-x1) + # dintercept.pointestimate = (1+m*x1-y1)/m + # rm(m,y1,y2,x1,x2) # removed to prevent confusions as used in later chunks + # + # dintercept.pointestimate = ((1-tau.hagg[firstbelow1-1])* + # (r.mid[firstbelow1]-r.mid[firstbelow1-1])/ + # (tau.hagg[firstbelow1]-tau.hagg[firstbelow1-1]))+r.mid[firstbelow1-1] + # dintercept.pointestimate + # save(dintercept.pointestimate, file = "dintercept.pointestimate.RData") + # + # plot(NULL, xlim = c(0,100), log="y", ylim = c(min(tauCItmp2500noinfs), + # max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + # ylab = "", xlab = "") + # mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) + # mtext(latex2exp::TeX( + # 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) + # mtext(latex2exp::TeX( + # 'from an average case (m)'), side=1, line=4, cex = 1.5) + # for (i in 1:2500) { + # lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) + # } + # for (i in 1:100) { + # lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) + # } + # axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", + # "16·0","32·0","64·0","93·0"), lwd = 4) + # axis(1, lwd = 4) + # lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap + # par(lend=1); + # lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), + # type = "l", lwd = 20, col = "red") + # lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), + # type = "l", lwd = 20, col = "blue") + # lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) + # lines(r.mid, tau.hagg, lwd = 4) + # legend(x = 40, y = 32, + # legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), + # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), + # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), + # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + # latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), + # lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, + # yjust = 0.5) - for (i in 1:permutations) { - lines(r, tau.permute[i,], col = scales::alpha("grey", alpha = 0.3), lwd = 1) - } - yaxis.range = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)) - yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) - yaxis.lab = sort(yaxis.lab) - yaxis.lab = round(yaxis.lab,digits = 1) - yaxis.lab = unique(yaxis.lab) # prevents more than one 1.0 value - yaxis.lab[which(yaxis.lab==1)] = round(yaxis.lab[which(yaxis.lab==1)],digits = 0) - axis(2, las=1, at=yaxis.lab, labels = as.character(yaxis.lab), lwd = 1) - lines(GET.res$r, GET.res$lo, col = "slategrey", lwd = 3) - lines(GET.res$r, GET.res$hi, col = "slategrey", lwd = 3) - lines(GET.res$r, GET.res$central, col = "red", lwd = 3) - lines(GET.res$r, GET.res$obs, lwd = 4) - axis(1, lwd = 1) - abline(h=1, lty = 2, lwd = 4) - legend("topright", legend=c(as.expression(bquote(~ hat(tau) ~ "point estimate")), - "95% global envelope",as.expression(bquote("simulations of " ~ H[0])), - "median simulation", - as.expression(bquote(~ tau == 1)) ), - col=c("black", "slategrey", "grey", "red", "black"), - lty=c(1,1,1,1,2), cex=1.05, yjust = 0.5, lwd = 6) - par(xpd = TRUE) - pint.lo = round(attr(GET.res,"p_interval"), digits = 3)[1] - pint.hi = round(attr(GET.res,"p_interval"), digits = 3)[2] - pint.x = 0.5 * max(r, na.rm = TRUE) - pint.y = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))) - text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } -plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, ...) +plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) { + stopifnot(class(x)=="tau") if(!is.null(ptwise.CI)){ stopifnot(class(ptwise.CI)=="tauCI") } + if(!is.null(GET.res)){ + stopifnot(class(GET.res)=="tauGET") + } + if(!is.null(ptwise.CI) & !is.null(GET.res)){ + stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and global + envelopes to be plotted on the same graph") + } if(r.mid==TRUE){ r.end = 0.5*(x$r.low + x$r) @@ -996,6 +1064,7 @@ plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, ...) xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") } + if(!is.null(ptwise.CI)){ plot(x = r.end, y = x$tau.pt.est, xlim=xlim, ylim=range(x$tau.pt.est, na.rm = TRUE)+diff(range(x$tau.pt.est, na.rm = TRUE))*c(-0.05,0.05), @@ -1010,6 +1079,41 @@ plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, ...) legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), col="black", pch=16 ) + } + + if(!is.null(GET.res)){ + plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + ylab = "Tau", xlab = xlab, lwd = 4, cex.lab = 1.5) + + for (i in 1:permutations) { + lines(x$r, GET.res$tau.permute[,i], col = scales::alpha("grey", alpha = 0.3), lwd = 1) + } + yaxis.range = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)) + yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) + yaxis.lab = sort(yaxis.lab) + yaxis.lab = round(yaxis.lab,digits = 1) + yaxis.lab = unique(yaxis.lab) # prevents more than one 1.0 value + yaxis.lab[which(yaxis.lab==1)] = round(yaxis.lab[which(yaxis.lab==1)],digits = 0) + axis(2, las=1, at=yaxis.lab, labels = as.character(yaxis.lab), lwd = 1) + lines(GET.res$r, GET.res$lo, col = "slategrey", lwd = 3) + lines(GET.res$r, GET.res$hi, col = "slategrey", lwd = 3) + lines(GET.res$r, GET.res$central, col = "red", lwd = 3) + lines(GET.res$r, GET.res$obs, lwd = 4) + axis(1, lwd = 1) + abline(h=1, lty = 2, lwd = 4) + legend("topright", legend=c(as.expression(bquote(~ hat(tau) ~ "point estimate")), + "95% global envelope",as.expression(bquote("simulations of " ~ H[0])), + "median simulation", + as.expression(bquote(~ tau == 1)) ), + col=c("black", "slategrey", "grey", "red", "black"), + lty=c(1,1,1,1,2), cex=1.05, yjust = 0.5, lwd = 6) + par(xpd = TRUE) + pint.lo = round(attr(GET.res,"p_interval"), digits = 3)[1] + pint.hi = round(attr(GET.res,"p_interval"), digits = 3)[2] + pint.x = 0.5 * max(x$r, na.rm = TRUE) + pint.y = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))) + text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) + } } ##' Optimized version of \code{get.tau} for typed data From c8162cb2ab7fb7ef4cb702d643b712ab62b278e2 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 24 Mar 2020 12:15:26 +0000 Subject: [PATCH 40/70] Get ciIntercept working --- NEWS.md | 7 +++++ R/spatialfuncs.r | 81 +++++++++++++++++++++++++++--------------------- 2 files changed, 53 insertions(+), 35 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4e201e3..cd6167e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -33,3 +33,10 @@ Generic changes: informed this change. ## Bug fixes (top of list are most important) + +# Changes on the horizon +Please note that the Modified Marked Point Spatial Bootstrap as described in !CITE has not yet been +applied. In this reference !CITE it was applied to the tau odds estimator however for consistency +we have decided to delay its implementation so that we can apply it also to the tau prevalence +estimator also, and thus sync the implementations across all tau estimators. Therefore please be +aware that values from `get.tau.bootstrap()` and `get.tau.D.param.est()` are still due to change. \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 7aaae93..b4769dc 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -929,44 +929,54 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t return(GET.res) } -get.tau.D.param.est <- function(){ +get.tau.D.param.est <- function(posmat, fun, r, r.low, boot.iter, comparison.type, GETres = NULL, ...){ + stopifnot(!is.null(GETres)) # makes sure the user has been principled and performed a global + # hypothesis test using get.tau() before estimating D + stopifnot(length(r)>1) - # ciIntercept <- function(n.sim, mid.set, tau.sim) { - # j.max = length(mid.set) - # # now define d.envelope - # alwaysabove1 = 0 - # d.envelope = NULL - # for (i in 1:n.sim) { - # j = 1 - # if(tau.sim[i,j] > 1){ # else ignore simulation as starting from below tau = 1 - # stillabove1 = T - # while (stillabove1 & (j < j.max)) { - # j = j + 1 - # if(tau.sim[i,j] <= 1){ # else it stays above tau = 1 until the next j is tested - # stillabove1 = F - # root.tau1 = ((1-tau.sim[i,(j-1)])*(mid.set[j]-mid.set[j-1])/ - # (tau.sim[i,j]-tau.sim[i,(j-1)]))+mid.set[j-1] - # d.envelope = c(d.envelope, root.tau1) - # } - # } - # if(stillabove1 & j==j.max){ - # alwaysabove1 = alwaysabove1 + 1 - # } - # } - # } - # # print warnings as if the value is much below 100% then a CI can't be constructed as - # # it has not been drawn from a random sample. - # print(paste0("sims cross tau = 1 from above = ",length(d.envelope)/n.sim*100,"%")) - # print(paste0("alwaysabove1 = ",alwaysabove1/n.sim*100,"%")) - # return(d.envelope) - # } - # + tausim = get.tau.bootstrap(posmat = posmat, fun = fun, r = r, r.low = r.low, boot.iter = boot.iter, comparison.type = comparison.type)[,-c(1,2)] + tausim = t(tausim) + + ciIntercept <- function(boot.iter, r, tausim) { + j.max = length(r) + # define d.envelope by finding for each bootstrap sample the (interpolated) d-intercept point + alwaysabove1 = 0 + d.envelope = NULL + for (i in 1:boot.iter) { + j = 1 # first distance band + if(tausim[i,j] > 1){ # else ignore simulation as starting from below tau = 1 + stillabove1 = TRUE + while (stillabove1 & (j < j.max)) { + j = j + 1 + if(tausim[i,j] <= 1){ # else it stays above tau = 1 until the next j is tested + stillabove1 = FALSE + root.tau1 = ((1-tausim[i,(j-1)])*(r[j]-r[j-1])/(tausim[i,j]-tausim[i,(j-1)]))+r[j-1] + d.envelope = c(d.envelope, root.tau1) + } + } + if(stillabove1 & j==j.max){ + alwaysabove1 = alwaysabove1 + 1 + } + } + } + print("Note the following values below. If the % of bootstrap sims always above tau = 1 is more than + a few percent then a reliable CI cannot be constructed as it will have not been drawn from + a random sample.") + print(paste0("% of sims crossing tau = 1 from above is ",length(d.envelope)/boot.iter*100,"%")) + print(paste0("% of bootstrap sims always above tau = 1 is ",alwaysabove1/boot.iter*100,"%")) + if(alwaysabove1>0){ + warning("Note that there are some bootstrap sims that stay above tau = 1 for the entire + distance band set. If more than a few percent of these are above tau = 1 then a + reliable CI cannot be constructed as it will have not have come from a random sample.") + } + return(d.envelope) + } + d.envelope = as.data.frame(ciIntercept(boot.iter,r,tausim)) #tauCI2500lohv2 = summonTauBstraplohv2(X.region = as.matrix(hag.dat), r.min = r.min, #r.max = r.max, bootiters = 2500, T1 = 0, T2 = 14) - #d.envelope2500lohv2 = ciIntercept(2500, mid.set = r.mid, tau.sim = tauCI2500lohv2) + #d.envelope2500lohv2 = ciIntercept(2500, mid.set = r.mid, tausim = tauCI2500lohv2) - # # quantile(d.envelope100, probs = c(0.025,0.975)) # # # compute where on d-axis the point estimate intercepts tau(d) = 1---- @@ -1019,9 +1029,10 @@ get.tau.D.param.est <- function(){ # latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), # lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, # yjust = 0.5) - + class(d.envelope) <- "tauparamest" + return(d.envelope) } - + plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) { stopifnot(class(x)=="tau") From 91bfd82eb5926246d740e6670dcd7fc6440cef38 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 24 Mar 2020 13:23:50 +0000 Subject: [PATCH 41/70] Integrate tauparamest with plot.tau() --- R/spatialfuncs.r | 104 ++++++++++++++++++++--------------------------- 1 file changed, 43 insertions(+), 61 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index b4769dc..3c719a7 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -959,10 +959,7 @@ get.tau.D.param.est <- function(posmat, fun, r, r.low, boot.iter, comparison.typ } } } - print("Note the following values below. If the % of bootstrap sims always above tau = 1 is more than - a few percent then a reliable CI cannot be constructed as it will have not been drawn from - a random sample.") - print(paste0("% of sims crossing tau = 1 from above is ",length(d.envelope)/boot.iter*100,"%")) + print(paste0("% of boostrap sims crossing tau = 1 from above is ",length(d.envelope)/boot.iter*100,"%")) print(paste0("% of bootstrap sims always above tau = 1 is ",alwaysabove1/boot.iter*100,"%")) if(alwaysabove1>0){ warning("Note that there are some bootstrap sims that stay above tau = 1 for the entire @@ -971,64 +968,10 @@ get.tau.D.param.est <- function(posmat, fun, r, r.low, boot.iter, comparison.typ } return(d.envelope) } - d.envelope = as.data.frame(ciIntercept(boot.iter,r,tausim)) + envelope = ciIntercept(boot.iter,r,tausim) + d.envelope = as.data.frame(envelope) + attr(d.envelope,"BCaCI") = coxed::bca(d.envelope$envelope, conf.level = 0.95) - #tauCI2500lohv2 = summonTauBstraplohv2(X.region = as.matrix(hag.dat), r.min = r.min, - #r.max = r.max, bootiters = 2500, T1 = 0, T2 = 14) - #d.envelope2500lohv2 = ciIntercept(2500, mid.set = r.mid, tausim = tauCI2500lohv2) - - # quantile(d.envelope100, probs = c(0.025,0.975)) - # - # # compute where on d-axis the point estimate intercepts tau(d) = 1---- - # firstbelow1 = which(tau.hagg < 1)[1] # when does the point estimate first fall below tau=1 - # y1 = tau.hagg[firstbelow1-1] - # y2 = tau.hagg[firstbelow1] - # x1 = r.mid[firstbelow1-1] - # x2 = r.mid[firstbelow1] - # m = (y2-y1)/(x2-x1) - # dintercept.pointestimate = (1+m*x1-y1)/m - # rm(m,y1,y2,x1,x2) # removed to prevent confusions as used in later chunks - # - # dintercept.pointestimate = ((1-tau.hagg[firstbelow1-1])* - # (r.mid[firstbelow1]-r.mid[firstbelow1-1])/ - # (tau.hagg[firstbelow1]-tau.hagg[firstbelow1-1]))+r.mid[firstbelow1-1] - # dintercept.pointestimate - # save(dintercept.pointestimate, file = "dintercept.pointestimate.RData") - # - # plot(NULL, xlim = c(0,100), log="y", ylim = c(min(tauCItmp2500noinfs), - # max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", - # ylab = "", xlab = "") - # mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) - # mtext(latex2exp::TeX( - # 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) - # mtext(latex2exp::TeX( - # 'from an average case (m)'), side=1, line=4, cex = 1.5) - # for (i in 1:2500) { - # lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) - # } - # for (i in 1:100) { - # lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) - # } - # axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", - # "16·0","32·0","64·0","93·0"), lwd = 4) - # axis(1, lwd = 4) - # lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap - # par(lend=1); - # lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), - # type = "l", lwd = 20, col = "red") - # lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), - # type = "l", lwd = 20, col = "blue") - # lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) - # lines(r.mid, tau.hagg, lwd = 4) - # legend(x = 40, y = 32, - # legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), - # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), - # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), - # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - # latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), - # lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, - # yjust = 0.5) class(d.envelope) <- "tauparamest" return(d.envelope) } @@ -1125,6 +1068,45 @@ plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) pint.y = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))) text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } + + + # plot(NULL, xlim = c(0,100), log="y", ylim = c(min(tauCItmp2500noinfs), + # max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + # ylab = "", xlab = "") + # mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) + # mtext(latex2exp::TeX( + # 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) + # mtext(latex2exp::TeX( + # 'from an average case (m)'), side=1, line=4, cex = 1.5) + # for (i in 1:2500) { + # lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) + # } + # for (i in 1:100) { + # lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) + # } + # axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", + # "16·0","32·0","64·0","93·0"), lwd = 4) + # axis(1, lwd = 4) + # lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap + # par(lend=1); + # lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), + # type = "l", lwd = 20, col = "red") + # lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), + # type = "l", lwd = 20, col = "blue") + # lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) + # lines(r.mid, tau.hagg, lwd = 4) + # legend(x = 40, y = 32, + # legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), + # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), + # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), + # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + # latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), + # lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, + # yjust = 0.5) + + + } ##' Optimized version of \code{get.tau} for typed data From 6d9111c479764cef063b0944c8a42b3bd5847720 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 24 Mar 2020 17:37:31 +0000 Subject: [PATCH 42/70] Continue to insert D.param.est plotting methods inside plot.tau(). Now just about to tweak get.tau.bootstrap to make its return value a class. --- R/spatialfuncs.r | 91 ++++++++++++++++++++++++++---------------------- 1 file changed, 49 insertions(+), 42 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 3c719a7..da5fb31 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -929,13 +929,12 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t return(GET.res) } -get.tau.D.param.est <- function(posmat, fun, r, r.low, boot.iter, comparison.type, GETres = NULL, ...){ +get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ stopifnot(!is.null(GETres)) # makes sure the user has been principled and performed a global # hypothesis test using get.tau() before estimating D stopifnot(length(r)>1) - tausim = get.tau.bootstrap(posmat = posmat, fun = fun, r = r, r.low = r.low, boot.iter = boot.iter, comparison.type = comparison.type)[,-c(1,2)] - tausim = t(tausim) + tausim = t(tausim[,-c(1,2)]) ciIntercept <- function(boot.iter, r, tausim) { j.max = length(r) @@ -976,7 +975,7 @@ get.tau.D.param.est <- function(posmat, fun, r, r.low, boot.iter, comparison.typ return(d.envelope) } -plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) +plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = NULL, d.param.est = NULL ...) { stopifnot(class(x)=="tau") if(!is.null(ptwise.CI)){ @@ -985,10 +984,21 @@ plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) if(!is.null(GET.res)){ stopifnot(class(GET.res)=="tauGET") } + if(!is.null(d.param.est)){ + stopifnot(class(d.param.est)=="tauparamest") + } if(!is.null(ptwise.CI) & !is.null(GET.res)){ stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and global envelopes to be plotted on the same graph") } + if(!is.null(ptwise.CI) & !is.null(d.param.est)){ + stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and clustering + range estimates to be plotted on the same graph") + } + if(!is.null(GET.res) & !is.null(d.param.est)){ + stop("To avoid misinterpretation of visual results we do not allow global envelopes and + clustering range estimates to be plotted on the same graph") + } if(r.mid==TRUE){ r.end = 0.5*(x$r.low + x$r) @@ -1069,44 +1079,41 @@ plot.tau <- function(x, r.mid = TRUE, ptwise.CI = NULL, GET.res = NULL, ...) text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } - - # plot(NULL, xlim = c(0,100), log="y", ylim = c(min(tauCItmp2500noinfs), - # max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", - # ylab = "", xlab = "") - # mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) - # mtext(latex2exp::TeX( - # 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) - # mtext(latex2exp::TeX( - # 'from an average case (m)'), side=1, line=4, cex = 1.5) - # for (i in 1:2500) { - # lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) - # } - # for (i in 1:100) { - # lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) - # } - # axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", - # "16·0","32·0","64·0","93·0"), lwd = 4) - # axis(1, lwd = 4) - # lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap - # par(lend=1); - # lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), - # type = "l", lwd = 20, col = "red") - # lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), - # type = "l", lwd = 20, col = "blue") - # lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) - # lines(r.mid, tau.hagg, lwd = 4) - # legend(x = 40, y = 32, - # legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), - # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), - # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - # latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), - # latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - # latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), - # lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, - # yjust = 0.5) - - - + if(is.null(d.param.est)){ + plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(x$tau.pt.est, ), + max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "", xlab = "") + mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) + mtext(latex2exp::TeX( + 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) + mtext(latex2exp::TeX( + 'from an average case (m)'), side=1, line=4, cex = 1.5) + for (i in 1:2500) { + lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) + } + for (i in 1:100) { + lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) + } + axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", + "16·0","32·0","64·0","93·0"), lwd = 4) + axis(1, lwd = 4) + lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap + par(lend=1); + lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), + type = "l", lwd = 20, col = "red") + lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), + type = "l", lwd = 20, col = "blue") + lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) + lines(r.mid, tau.hagg, lwd = 4) + legend(x = 40, y = 32, + legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), + latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), + latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), + latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), + latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), + lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, + yjust = 0.5) + } } ##' Optimized version of \code{get.tau} for typed data From 3082c64afee04f8f5274edff35cf073ab6218776 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Tue, 24 Mar 2020 20:29:06 +0000 Subject: [PATCH 43/70] Now going to test the implementation of D.param.est in plot.tau --- R/spatialfuncs.r | 47 +++++++++++++++++++++-------------------------- 1 file changed, 21 insertions(+), 26 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index da5fb31..6e2bcb4 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -933,7 +933,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ stopifnot(!is.null(GETres)) # makes sure the user has been principled and performed a global # hypothesis test using get.tau() before estimating D stopifnot(length(r)>1) - + stopifnot(class(tausim)=="taubstrap") tausim = t(tausim[,-c(1,2)]) ciIntercept <- function(boot.iter, r, tausim) { @@ -975,7 +975,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ return(d.envelope) } -plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = NULL, d.param.est = NULL ...) +plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = NULL, d.param.est = NULL, ...) { stopifnot(class(x)=="tau") if(!is.null(ptwise.CI)){ @@ -987,6 +987,9 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = if(!is.null(d.param.est)){ stopifnot(class(d.param.est)=="tauparamest") } + if(!is.null(tausim)){ + stopifnot(class(tausim)=="taubstrap") + } if(!is.null(ptwise.CI) & !is.null(GET.res)){ stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and global envelopes to be plotted on the same graph") @@ -1080,18 +1083,12 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = } if(is.null(d.param.est)){ - plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(x$tau.pt.est, ), - max(tauCItmp2500noinfs)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "", xlab = "") - mtext(latex2exp::TeX('$\\tau (d_l,d_m)$'), side=2, line=2, cex = 1.5) - mtext(latex2exp::TeX( - 'Distance band midpoint (1/2$(d_l + d_m)$) at 2m increments,'), side=1, line=3, cex = 1.5) - mtext(latex2exp::TeX( - 'from an average case (m)'), side=1, line=4, cex = 1.5) - for (i in 1:2500) { - lines(r.mid, tauCItmp2500noinfs[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) - } - for (i in 1:100) { - lines(r.mid, tauCItmp100noinfs[i,], col = scales::alpha("green", alpha = 0.2), lwd = 4) + plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(x$tau.pt.est, tausim, na.rm = TRUE), + max(x$tau.pt.est, tausim, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "", xlab = "") + mtext("Tau", side=2, line=2, cex = 1.5) + mtext(xlab, side=1, line=3, cex = 1.5) + for (i in 1:dim(tausims)[1]) { + lines(x$r, tausims[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) } axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", "16·0","32·0","64·0","93·0"), lwd = 4) @@ -1100,17 +1097,13 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = par(lend=1); lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), type = "l", lwd = 20, col = "red") - lines(x = as.numeric(quantile(d.envelope100, probs = c(0.025,0.975))), y=c(0.97,0.97), - type = "l", lwd = 20, col = "blue") lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) - lines(r.mid, tau.hagg, lwd = 4) + lines(x$r, x$tau.pt.est, lwd = 4) legend(x = 40, y = 32, - legend=c(latex2exp::TeX('$\\hat{\\tau}$ point estimate & $\\hat{D}$'), - latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=2500)'), - latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - latex2exp::TeX('$\\hat{\\underline{\\tau}}^*$ bootstrap estimate (N=100)'), - latex2exp::TeX(' $\\bullet$ 95% percentile CI of $\\underline{D}$'), - latex2exp::TeX('$\\tau = 1$')), col=c("black", "grey", "red", "green", "blue", "black"), + legend=c(as.expression(bquote(hat(tau) ~ "point estimate & " ~ hat(D))), + as.expression(bquote(underline(tau)^["*"] ~ "bootstrap estimate (N=" ~ .(dim(tausim)[1]) ~ ")")), + as.expression(bquote("95% BCa CI of " ~ underline(D))), + as.expression(bquote(tau = 1))), col=c("black", "grey", "red", "green", "blue", "black"), lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, yjust = 0.5) } @@ -1262,8 +1255,7 @@ get.tau.bootstrap <- function(posmat, comparison.type = "representative", data.frame=TRUE) { - - xcol <- which(colnames(posmat)=="x") + xcol <- which(colnames(posmat)=="x") ycol <- which(colnames(posmat)=="y") #check that both columns exist @@ -1294,9 +1286,12 @@ get.tau.bootstrap <- function(posmat, } if (data.frame == FALSE) { + class(rc) <- "taubstrap" return(rc) } else if (data.frame == TRUE) { - return(data.frame(r.low=r.low, r=r, t(rc))) + rc = data.frame(r.low=r.low, r=r, t(rc)) + class(rc) <- "taubstrap" + return(rc) } } From 2cd885b1b612ef210ee8525e4cb0139f7e9572f3 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 10:22:18 +0000 Subject: [PATCH 44/70] Completion of incorporation of d.param.est in plot.tau() --- R/spatialfuncs.r | 55 ++++++++++++++++++++++++++---------------------- 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 6e2bcb4..1a5585c 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -934,8 +934,9 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ # hypothesis test using get.tau() before estimating D stopifnot(length(r)>1) stopifnot(class(tausim)=="taubstrap") - tausim = t(tausim[,-c(1,2)]) - + if(!is.null(names(tausim))){ # ie if tausim is like a 'data.frame despite having a taubstrap class + tausim = t(tausim[,-c(1,2)]) + } ciIntercept <- function(boot.iter, r, tausim) { j.max = length(r) # define d.envelope by finding for each bootstrap sample the (interpolated) d-intercept point @@ -1038,9 +1039,7 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = cex.axis=1.,col="black", xlab=xlab, ylab="Tau", cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) - if(!is.null(ptwise.CI)){ arrows(r.end, ptwise.CI$ci.low, r.end, ptwise.CI$ci.high, length = 0.04, angle = 90, code = 3) - } abline(h=1,lty=2) legend("topright", legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), @@ -1051,7 +1050,6 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = if(!is.null(GET.res)){ plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "Tau", xlab = xlab, lwd = 4, cex.lab = 1.5) - for (i in 1:permutations) { lines(x$r, GET.res$tau.permute[,i], col = scales::alpha("grey", alpha = 0.3), lwd = 1) } @@ -1082,30 +1080,37 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } - if(is.null(d.param.est)){ - plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(x$tau.pt.est, tausim, na.rm = TRUE), - max(x$tau.pt.est, tausim, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "", xlab = "") - mtext("Tau", side=2, line=2, cex = 1.5) + if(!is.null(d.param.est)){ + xlim = c(0,min(2*median(gettaueg$envelope),max(x$r))) + yaxis.range = c(min(x$tau.pt.est, tausim, na.rm = TRUE),max(x$tau.pt.est, tausim, + na.rm = TRUE)) + yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) + yaxis.lab = sort(yaxis.lab) + yaxis.lab = round(yaxis.lab,digits = 1) + yaxis.lab = unique(yaxis.lab) # prevents more than one 1.0 value + yaxis.lab[which(yaxis.lab==1)] = round(yaxis.lab[which(yaxis.lab==1)],digits = 0) + plot(NULL, xlim = xlim, ylim = yaxis.range, xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + ylab = "", xlab = "") + mtext("Tau", side=2, line=3, cex = 1.5) mtext(xlab, side=1, line=3, cex = 1.5) - for (i in 1:dim(tausims)[1]) { - lines(x$r, tausims[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) + for (i in 1:dim(tausim)[1]) { + lines(x$r, tausim[i,], col = scales::alpha("grey", alpha = 0.2), lwd = 4) } - axis(2, las=1, at=c(0.5,1,2,4,8,16,32,64,93), labels = c("0·5","1","2·0","4·0","8·0", - "16·0","32·0","64·0","93·0"), lwd = 4) - axis(1, lwd = 4) - lines(x = c(0,100), y = c(1,1), lty = 2, lwd = 4) # as abline seems to overlap + axis(2, las=1, at=yaxis.lab, labels = as.character(yaxis.lab), lwd = 1) + axis(1, lwd = 1) + lines(x = c(0,max(x$r, na.rm = TRUE)), y = c(1,1), lty = 2, lwd = 1) # as abline seems to overlap par(lend=1); - lines(x = as.numeric(quantile(d.envelope2500, probs = c(0.025,0.975))), y=c(1.03,1.03), + lines(x = attr(gettaueg,"BCaCI"), y=c(1.03,1.03), type = "l", lwd = 20, col = "red") - lines(x=c(dintercept.pointestimate,dintercept.pointestimate), y = c(0.9,1.1), lwd = 8) - lines(x$r, x$tau.pt.est, lwd = 4) - legend(x = 40, y = 32, - legend=c(as.expression(bquote(hat(tau) ~ "point estimate & " ~ hat(D))), - as.expression(bquote(underline(tau)^["*"] ~ "bootstrap estimate (N=" ~ .(dim(tausim)[1]) ~ ")")), - as.expression(bquote("95% BCa CI of " ~ underline(D))), - as.expression(bquote(tau = 1))), col=c("black", "grey", "red", "green", "blue", "black"), - lty=c(1,1,1,1,1,2), lwd = c(6,6,30,6,30,6), pch = c(124,256,256,256,256,256), cex=1.05, - yjust = 0.5) + dintercept.ptest = median(d.param.est$envelope) + lines(x=c(dintercept.ptest,dintercept.ptest), y = c(0.9,1.1), lwd = 4) + lines(x$r, x$tau.pt.est, lwd = 4, col = "black") + legend("topright", + legend=c(as.expression(bquote(hat(tau) ~ "point estimate & " ~ hat(D) ~ "estimate")), + as.expression(bquote(underline(tau)^"*" ~ "bootstrap estimate (N=" ~ .(dim(tausim)[1]) * ")")), + as.expression(bquote("95% BCa CI of " ~ underline(D))),"tau = 1"), + col=c("black", "grey", "red", "black"), + lty=c(1,1,1,2), lwd = c(2,2,10,1), pch = c(124,NA,NA,NA), cex=1.05, xjust = 1, yjust = 0.5) } } From 295746a16eb064692bffc066cd6c509aebfdd8ab Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 14:27:14 +0000 Subject: [PATCH 45/70] Start documentation update --- DESCRIPTION | 2 +- NEWS.md | 36 +++++++++++++++++++++++------------- 2 files changed, 24 insertions(+), 14 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 1a3b5c0..270692f 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDSpatialStats Version: 1.0.0 -Date: 2020-02-06 +Date: 2020-03-25 Title: Estimate Global Clustering in Infectious Disease Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9741-8109", "Co-creator & maintainer"), email = "justin@jhu.edu"), diff --git a/NEWS.md b/NEWS.md index cd6167e..8e59b37 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,17 +1,27 @@ -# IDSpatialStats 1.0.0 +# News on IDSpatialStats 1.0.0 release +====== ## Changes (top of list are most important) -These changes mostly concern the tau statistic functions. These are big changes and we may have -unwittingly introduced bugs. Please send us a reproducible example if you find one. - -Specific changes -* `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca` to - compute BCa (bias-corrected and accelerated) confidence intervals (CIs) rather than percentile. - Note this will result in a change in your results versus previous versions if if computing CIs. - `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. - At times the `coxed::bca()` method gives slightly different test results if it is applied to - asymmetric distributions. -* `get.tau()` returns a new S3 `tau` class with special methods for: +These changes mostly concern the tau statistic functions and have resulted in a major change revision from 0.3.9 to 1.0.0: these are big changes and we may have introduced bugs so please send us a `reprex()` example. We also note where function outputs are likely to have changed. + +# Specific changes +Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and accelerated) CIs +* `get.pi.ci()`, `get.theta.ci()`, `get.tau.ci()`: `quantile` method replaced with `coxed::bca`. This will change CI results. + +* `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. At times the `coxed::bca()` method gives slightly different test results if it is applied to asymmetric distributions. + +* New S3 classes have been added to the return objects from the following functions. The purpose of the new classes is to encourage the use of functions in an ordered and principled way, in keeping with good practices of statistical inference [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")]. It also means that the objects inputted as function arguments are of a known format: + + + + + + + + +* `get.tau()` returns a new S3 `tau` class + +* with special methods for: * `plot()` provides a tau-distance graph with an option for pointwise confidence intervals for a visual indication of spatiotemporal clustering. In this version we use error bars as default, to remind the reader that this graph should not be used as a graphical hypothesis test for the whole @@ -27,7 +37,7 @@ that follow current best-practice mentioned in a recent review of the tau statis have not been removed. * NEWS.md file added, but as you're reading this you probably knew that already ;) -Generic changes: +# Generic changes * ability to have distance units defined and automatically plotted on graph * documentation updated, with rationale for use with linked references to recent literature which has informed this change. From 20d8ffbffad30cf2d1cddfc59d082e31a3bf8d77 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 14:32:50 +0000 Subject: [PATCH 46/70] Indent trial --- NEWS.md | 1 - 1 file changed, 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 8e59b37..65a9d05 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,4 @@ # News on IDSpatialStats 1.0.0 release -====== ## Changes (top of list are most important) These changes mostly concern the tau statistic functions and have resulted in a major change revision from 0.3.9 to 1.0.0: these are big changes and we may have introduced bugs so please send us a `reprex()` example. We also note where function outputs are likely to have changed. From 092e443b8fd0529f2d760ebf8d407a736f207605 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 15:39:34 +0000 Subject: [PATCH 47/70] NEWS.md nearly finished --- NEWS.md | 31 ++++++++++++++----------------- R/spatialfuncs.r | 12 ++++++------ README.md | 2 ++ inst/CITATION | 17 +++++++++-------- 4 files changed, 31 insertions(+), 31 deletions(-) diff --git a/NEWS.md b/NEWS.md index 65a9d05..2b1d98c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,26 +9,20 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce * `quantile` method also updated to `coxed::bca` where possible in `inst/tests/`. At times the `coxed::bca()` method gives slightly different test results if it is applied to asymmetric distributions. -* New S3 classes have been added to the return objects from the following functions. The purpose of the new classes is to encourage the use of functions in an ordered and principled way, in keeping with good practices of statistical inference [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")]. It also means that the objects inputted as function arguments are of a known format: - - +* New function `get.tau.GET()` performs graphical hypothesis tests with the tau statistic using the `GET` package, while `get.tau.D.param.est()` estimates the range of spatiotemporal clustering. +* `plot.tau()` is a new method that can produce three types of tau(y-axis)-distance(x-axis) plots [[1: see Graphical abstract](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")]: + * Diagnostic to indicate the structure or magnitude of spatiotemporal clustering. Requires `tau` object; `tauCI` object optional to draw pointwise CIs. In this version we use piecewise error bars rather than continuous envelope lines. This reminds the user that this graph should not be used as a graphical hypothesis test for the whole distance range observed. It is only suitable for the purpose of a graphical hypothesis test for a specific distance band if that band is decided prior to graph creation. + * Graphical hypothesis tests to assess the evidence against the Null hypothesis (no spatiotemporal clustering nor inhibition). Requires `tau` and `tauGET` objects. + * Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires `tau` and `tauparamest` objects; prior to this `get.tau.D.param.est()` requires a `taubstrap` object. - - +* New S3 classes have been added to the return objects from the following functions. The purpose of the new classes is to encourage the use of functions in an ordered and principled way, in keeping with good practices of statistical inference [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")]. It also means that the objects inputted as function arguments are of a known format: + * `get.tau()` returns a `tau` class + * `get.tau.ci()` returns a `tauCI` class + * `get.tau.GET()` returns a `tauGET` class + * `get.tau.bootstrap()` returns a `taubstrap` class + * `get.tau.D.param.est()` returns a `tauparamest` class. Requires a `taubstrap` object - -* `get.tau()` returns a new S3 `tau` class - -* with special methods for: - * `plot()` provides a tau-distance graph with an option for pointwise confidence intervals for - a visual indication of spatiotemporal clustering. In this version we use error bars as default, to - remind the reader that this graph should not be used as a graphical hypothesis test for the whole - distance range observed (CITE!). It is only suitable for the purpose of a graphical hypothesis - test if a specific distance band is decided before looking at the graph to see if it encloses - tau=1. - -that follow current best-practice mentioned in a recent review of the tau statistic. * CITATION file added * README.md formatting updated * `get.tau$tau` renamed to `get.tau$tau.pt.est` @@ -43,6 +37,9 @@ informed this change. ## Bug fixes (top of list are most important) +# Release contributors +Timothy M Pollington would also like to thank the co-authors of the paper that informed this update[[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] and particularly the *essential* contribution of Peter J. Diggle (Lancaster) who advised on this principled inferential approach, but respectfully declined co-authorship. + # Changes on the horizon Please note that the Modified Marked Point Spatial Bootstrap as described in !CITE has not yet been applied. In this reference !CITE it was applied to the tau odds estimator however for consistency diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 1a5585c..52d7f85 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1032,14 +1032,14 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") } - if(!is.null(ptwise.CI)){ - plot(x = r.end, y = x$tau.pt.est, - xlim=xlim, + if(is.null(GET.res) & is.null(d.param.est)){ + plot(x = r.end, y = x$tau.pt.est, xlim=xlim, ylim=range(x$tau.pt.est, na.rm = TRUE)+diff(range(x$tau.pt.est, na.rm = TRUE))*c(-0.05,0.05), - cex.axis=1.,col="black", xlab=xlab, - ylab="Tau", + cex.axis=1.,col="black", xlab=xlab, ylab="Tau", cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) - arrows(r.end, ptwise.CI$ci.low, r.end, ptwise.CI$ci.high, length = 0.04, angle = 90, code = 3) + if(!is.null(ptwise.CI)){ + arrows(r.end, ptwise.CI$ci.low, r.end, ptwise.CI$ci.high, length = 0.04, angle = 90, code = 3) + } abline(h=1,lty=2) legend("topright", legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), diff --git a/README.md b/README.md index 7ab164f..b58330f 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,7 @@ # IDSpatialStats +**Previous users: please read [News on the latest release](../blob/master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** + This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. The current implementation of the package includes a function which simulates infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: diff --git a/inst/CITATION b/inst/CITATION index 985cfaa..fdc1c64 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -48,13 +48,14 @@ c(bibentry( ) bibentry( - header = "For the method and rationale of graphical hypothesis testing for the tau statistic please also cite:", - key = "Pollington2019", - bibtype = "Unpublished", - title = "Measuring spatiotemporal disease clustering with the tau statistic", + header = "For the method and rationale of graphical hypothesis testing or clustering range estimation for the tau statistic please also cite:", + key = "Pollington2020", + bibtype = "Article", + title = "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic", author = c(as.person("Timothy M. Pollington"),as.person("Michael J. Tildesley"),as.person("T. Déirdre Hollingsworth"),as.person("Lloyd A. C. Chapman")), - year = 2019, - journal = "arXiv", - url = "https://arxiv.org/abs/1911.08022", - note = "Under review" + year = 2020, + journal = "Spatial Statistics", + url = "https://doi.org/10.1016/j.spasta.2020.100438", + doi = "10.1016/j.spasta.2020.100438" + note = "Pre-proof" ) \ No newline at end of file From 38c96fa8104d16f06190f695b503042f31656426 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 15:45:47 +0000 Subject: [PATCH 48/70] greek letter trial --- README.md | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index b58330f..9bc571f 100644 --- a/README.md +++ b/README.md @@ -1,13 +1,11 @@ # IDSpatialStats -**Previous users: please read [News on the latest release](../blob/master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** +**Previous users: please read [News on the latest release](../master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** -This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. - -The current implementation of the package includes a function which simulates infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: +This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. This package can simulate infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: 1. the mean of the spatial transmission kernel, which is a measure of fine-scale spatial dependence between two cases, and -2. the tau statistic $\tau$, a measure of global clustering based on pathogen subtype and/or, serotype and/or case onset time. +2. the tau statistic τ, a measure of global clustering based on pathogen subtype and/or, serotype and/or case onset time. This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.com/gilesjohnR)) and Justin Lessler (GitHub: @[jlessler](https://github.com/jlessler)) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (GitHub: @[HopkinsIDD](https://github.com/HopkinsIDD)). From 9cc35f115988b1d49f8ff57a9e510ece4e18390b Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 17:57:57 +0000 Subject: [PATCH 49/70] News news news --- NEWS.md | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/NEWS.md b/NEWS.md index 2b1d98c..7203189 100644 --- a/NEWS.md +++ b/NEWS.md @@ -27,22 +27,19 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce * README.md formatting updated * `get.tau$tau` renamed to `get.tau$tau.pt.est` * Deprecated tests that were previously commented out in `inst/tests/` as a warning of removal - have not been removed. + have now been removed. * NEWS.md file added, but as you're reading this you probably knew that already ;) # Generic changes -* ability to have distance units defined and automatically plotted on graph -* documentation updated, with rationale for use with linked references to recent literature which has -informed this change. +* distance units can be defined on `r` and `r.low` and will be automatically feature in the x-axis label of `plot.tau()` +* documentation update ## Bug fixes (top of list are most important) +None # Release contributors -Timothy M Pollington would also like to thank the co-authors of the paper that informed this update[[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] and particularly the *essential* contribution of Peter J. Diggle (Lancaster) who advised on this principled inferential approach, but respectfully declined co-authorship. - -# Changes on the horizon -Please note that the Modified Marked Point Spatial Bootstrap as described in !CITE has not yet been -applied. In this reference !CITE it was applied to the tau odds estimator however for consistency -we have decided to delay its implementation so that we can apply it also to the tau prevalence -estimator also, and thus sync the implementations across all tau estimators. Therefore please be -aware that values from `get.tau.bootstrap()` and `get.tau.D.param.est()` are still due to change. \ No newline at end of file +Timothy M Pollington would like to thank the co-authors of the paper that informed this update[[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] and the *essential* contribution of Peter J. Diggle (Lancaster) who advised on this principled inferential approach. + +# Next changes +Please note that the Modified Marked Point Spatial Bootstrap [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] has not yet been +applied. In [[2](https://doi.org/10.5281/zenodo.2552850 "t-pollington/tau-statistic-speedup: First release of tau statistic speedup")] it was applied to the tau odds estimator however for consistency we have decided to delay its implementation so that we can apply it also to the tau prevalence estimator. So please note that `get.tau.bootstrap()` and `get.tau.D.param.est()` values are still likely to change. \ No newline at end of file From 5572c4a65da84e8d907eff6dfa46ca1d0094ac49 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:05:04 +0000 Subject: [PATCH 50/70] NEWS complete --- NEWS.md | 7 +++---- R/spatialfuncs.r | 6 +++--- README.md | 16 ++++++++-------- 3 files changed, 14 insertions(+), 15 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7203189..2f28bce 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,14 +21,13 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce * `get.tau.ci()` returns a `tauCI` class * `get.tau.GET()` returns a `tauGET` class * `get.tau.bootstrap()` returns a `taubstrap` class - * `get.tau.D.param.est()` returns a `tauparamest` class. Requires a `taubstrap` object + * `get.tau.D.param.est()` returns a `tauparamest` class. Requires a `taubstrap` object. * CITATION file added * README.md formatting updated * `get.tau$tau` renamed to `get.tau$tau.pt.est` -* Deprecated tests that were previously commented out in `inst/tests/` as a warning of removal - have now been removed. -* NEWS.md file added, but as you're reading this you probably knew that already ;) +* Previously deprecated tests (already commented out in `inst/tests/`) have now been removed. +* NEWS.md file added, but as you're reading this you probably knew that already :wink: # Generic changes * distance units can be defined on `r` and `r.low` and will be automatically feature in the x-axis label of `plot.tau()` diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 52d7f85..837b92f 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1019,17 +1019,17 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = # and label graph appropriately, with correct units if provided if(!is.null(attr(x$r.low, "units")) & !is.null(attr(x$r, "units")) & identical(attr(x$r.low, "units"), attr(x$r, "units"))){ - unitslabel = attr(x$r.low, "units") + unitslabel = c("(", attr(x$r.low, "units"), ")") } else{ unitslabel = "" } if(all(x$r.low==0)){ - xlab = bquote("Distance [0," * d[m] * ") from an average case (" * .(unitslabel) * ")") + xlab = bquote("Distance [0," * d[m] * ") from an average case " * .(unitslabel)) } else{ - xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case (" * .(unitslabel) * ")") + xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case " * .(unitslabel)) } if(is.null(GET.res) & is.null(d.param.est)){ diff --git a/README.md b/README.md index 9bc571f..8a7333b 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. This package can simulate infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: 1. the mean of the spatial transmission kernel, which is a measure of fine-scale spatial dependence between two cases, and -2. the tau statistic τ, a measure of global clustering based on pathogen subtype and/or, serotype and/or case onset time. +2. the tau statistic τ, a measure of global clustering based on any/all of pathogen subtype; serotype; case onset time. This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.com/gilesjohnR)) and Justin Lessler (GitHub: @[jlessler](https://github.com/jlessler)) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (GitHub: @[HopkinsIDD](https://github.com/HopkinsIDD)). @@ -17,7 +17,7 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Estimating infectious disease transmission distances using the overall distribution of cases (Salje et al. 2016)](http://www.sciencedirect.com/science/article/pii/S1755436516300317) -[Measuring spatiotemporal disease clustering with the tau statistic (Pollington et al. in review)](https://arxiv.org/abs/1911.08022) +[Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) @@ -28,7 +28,7 @@ To install the official release of the `IDSpatialStats` package, open `R` and ty install.packages('IDSpatialStats') ``` -To install the development version, first install the `devtools` package and then install `IDSpatialStats` from source via GitHub: +or for the development version, first install the `devtools` package and then `IDSpatialStats` from source via GitHub: ``` install.packages('devtools') devtools::install_github('HopkinsIDD/IDSpatialStats') @@ -38,11 +38,11 @@ devtools::install_github('HopkinsIDD/IDSpatialStats') For general questions, contact package maintainers John Giles (giles@jhu.edu) or Justin Lessler (justin@jhu.edu). -To report bugs or problems with documentation, please go to the [Issues](https://github.com/HopkinsIDD/IDSpatialStats/issues) page associated with this GitHub page and click *New issue*. +To report bugs or problems with documentation, please go to the [Issues](https://github.com/HopkinsIDD/IDSpatialStats/issues) page associated with this GitHub page and click *New issue*. Bugs clearly reported using the `reprex` package are encouraged. -If you wish to contribute to `IDSpatialStats`, please first get in touch via email. Then please: +If you wish to contribute to `IDSpatialStats`, please first get in touch via email. Then if we agree in principle please: -1. Fork a copy of the current development version on GitHub +1. Fork a copy of the current *development* version on GitHub 2. Add your functions and edits to your forked copy * pay attention to existing naming conventions and outputs * add examples @@ -51,9 +51,9 @@ If you wish to contribute to `IDSpatialStats`, please first get in touch via ema * often * describe what was done and why, but not how * use the imperative - * $\leq$ 72 characters + * < 72 characters e.g. "*Replace percentile CI with BCa CI, as tau bootstrap distrib. non-symm*" 3. Any modified functions must return identical output as the current functions. Check that modified functions return the same output using package `testthat` and consider writing new test cases if appropriate. For new functions, write test cases should test that functions return expected values given expected inputs, and that they behave as expected in boundary conditions. 4. Add conditional stops to functions so that they fail gracefully with unexpected inputs. -5. Submit a pull request when you are ready to share. \ No newline at end of file +5. Submit a pull request when you are ready to share. Thank you! \ No newline at end of file From af47153e0d7f4c0fb237041aff340b0dc5d51082 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:32:09 +0000 Subject: [PATCH 51/70] Img test --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 8a7333b..403550e 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ # IDSpatialStats -**Previous users: please read [News on the latest release](../master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** +**Previous users: please read [news on the latest release](../master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. This package can simulate infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: @@ -19,6 +19,8 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) +Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. + [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) ## Installation @@ -27,7 +29,6 @@ To install the official release of the `IDSpatialStats` package, open `R` and ty ``` install.packages('IDSpatialStats') ``` - or for the development version, first install the `devtools` package and then `IDSpatialStats` from source via GitHub: ``` install.packages('devtools') From 15cf8832d6da27262c9a0171600316391c27b802 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:34:42 +0000 Subject: [PATCH 52/70] make img bigger --- README.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 403550e..027556e 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,8 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) -Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. +Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation [(image source under a CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438). +Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. From doi.org/10.1016/j.spasta.2020.100438 under a CC-BY licence. [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) From 6b3cf92960a472387978b0e07fcae78112d8fb42 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:36:30 +0000 Subject: [PATCH 53/70] img test --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 027556e..de13faf 100644 --- a/README.md +++ b/README.md @@ -19,8 +19,8 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) -Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation [(image source under a CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438). -Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. From doi.org/10.1016/j.spasta.2020.100438 under a CC-BY licence. +Three tau statistic plots are illustrated below for diagnostic, graphical hypothesis tests and clustering range parameter estimation purposes [(image source under a CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438): +Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. From doi.org/10.1016/j.spasta.2020.100438 under a CC-BY licence. [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) From 8856b4957e2700689eef0e23e70234e6427c4bf1 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:40:08 +0000 Subject: [PATCH 54/70] Text wrap --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index de13faf..78037fd 100644 --- a/README.md +++ b/README.md @@ -20,8 +20,8 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) Three tau statistic plots are illustrated below for diagnostic, graphical hypothesis tests and clustering range parameter estimation purposes [(image source under a CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438): -Illustration of three types of plots of the tau statistic used for diagnostic, graphical hypothesis tests and clustering range parameter estimation. From doi.org/10.1016/j.spasta.2020.100438 under a CC-BY licence. - + +
[The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) ## Installation From 9a28132df4d7f0426755e781d9277b6c1283f628 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:41:41 +0000 Subject: [PATCH 55/70] Page restructure --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 78037fd..ff0a12e 100644 --- a/README.md +++ b/README.md @@ -19,10 +19,11 @@ This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.c [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) -Three tau statistic plots are illustrated below for diagnostic, graphical hypothesis tests and clustering range parameter estimation purposes [(image source under a CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438): +[The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) + +Three tau statistic plots are illustrated below for diagnostic, graphical hypothesis tests and clustering range parameter estimation purposes [(image source, CC-BY licence)](https://doi.org/10.1016/j.spasta.2020.100438):
-[The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) ## Installation From 798d20dd0452e7f0ce5b69bdbcc6b3ef9ac6b8b9 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:45:45 +0000 Subject: [PATCH 56/70] Add structure --- README.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index ff0a12e..11bf457 100644 --- a/README.md +++ b/README.md @@ -10,13 +10,15 @@ This GitHub repository provides source code for the `IDSpatialStats` R package, This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.com/gilesjohnR)) and Justin Lessler (GitHub: @[jlessler](https://github.com/jlessler)) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (GitHub: @[HopkinsIDD](https://github.com/HopkinsIDD)). ## Detailed description of the methods and relevant literature - +### Covering both transmission distance estimation and tau statistic [The IDSpatialStats R package: Quantifying spatial dependence of infectious disease spread (Giles et al. accepted)](https://journal.r-project.org/archive/2019/RJ-2019-043/index.html) [Measuring spatial dependence for infectious disease epidemiology (Lessler et al. 2016)](http://journals.plos.org/plosone/article?id=10.1371/journal.pone.0155249) +### Transmission distance-specific [Estimating infectious disease transmission distances using the overall distribution of cases (Salje et al. 2016)](http://www.sciencedirect.com/science/article/pii/S1755436516300317) +### Tau statistic-specific [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) From 8675b97875e900bee7211b4876e9dbedd8d8dac8 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Wed, 25 Mar 2020 18:47:27 +0000 Subject: [PATCH 57/70] restructure --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 11bf457..e1960a3 100644 --- a/README.md +++ b/README.md @@ -10,15 +10,15 @@ This GitHub repository provides source code for the `IDSpatialStats` R package, This package is maintained by John Giles (GitHub: @[gilesjohnr](https://github.com/gilesjohnR)) and Justin Lessler (GitHub: @[jlessler](https://github.com/jlessler)) as part of the Johns Hopkins Bloomberg School of Public Health Infectious Disease Dynamics team (GitHub: @[HopkinsIDD](https://github.com/HopkinsIDD)). ## Detailed description of the methods and relevant literature -### Covering both transmission distance estimation and tau statistic +### Transmission distance estimation and tau statistic [The IDSpatialStats R package: Quantifying spatial dependence of infectious disease spread (Giles et al. accepted)](https://journal.r-project.org/archive/2019/RJ-2019-043/index.html) [Measuring spatial dependence for infectious disease epidemiology (Lessler et al. 2016)](http://journals.plos.org/plosone/article?id=10.1371/journal.pone.0155249) -### Transmission distance-specific +### Transmission distance specific [Estimating infectious disease transmission distances using the overall distribution of cases (Salje et al. 2016)](http://www.sciencedirect.com/science/article/pii/S1755436516300317) -### Tau statistic-specific +### Tau statistic specific [Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic (Pollington et al. 2020 pre-proof)](https://doi.org/10.1016/j.spasta.2020.100438) [The spatiotemporal tau statistic: a review (Pollington et al. preprint)](https://arxiv.org/abs/1911.11476) From 713d2b60b47f978da4bf7da54722ad1292c2cd9f Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 13:57:30 +0000 Subject: [PATCH 58/70] Update help files. Example files next! --- DESCRIPTION | 4 +- NEWS.md | 7 +- R/spatialfuncs.r | 120 +++++++++++++++++++++++++----- README.md | 2 +- man/DengueSimR01.Rd | 4 +- man/DengueSimR02.Rd | 4 +- man/DengueSimRepresentative.Rd | 4 +- man/{get.pi.ci.Rd => applyBCa.Rd} | 18 ++--- man/get.pi.Rd | 9 ++- man/get.pi.bootstrap.Rd | 2 +- man/get.pi.permute.Rd | 2 +- man/get.pi.typed.Rd | 2 +- man/get.pi.typed.bootstrap.Rd | 2 +- man/get.pi.typed.permute.Rd | 2 +- man/get.tau.D.param.est.Rd | 58 +++++++++++++++ man/get.tau.GET.Rd | 79 ++++++++++++++++++++ man/get.tau.Rd | 18 +++-- man/get.tau.bootstrap.Rd | 5 +- man/get.tau.ci.Rd | 12 +-- man/get.tau.permute.Rd | 5 +- man/get.tau.typed.Rd | 5 +- man/get.tau.typed.bootstrap.Rd | 5 +- man/get.tau.typed.permute.Rd | 5 +- man/get.theta.Rd | 7 +- man/get.theta.ci.Rd | 7 +- man/plot.tau.Rd | 61 +++++++++++++++ 26 files changed, 377 insertions(+), 72 deletions(-) rename man/{get.pi.ci.Rd => applyBCa.Rd} (94%) create mode 100644 man/get.tau.D.param.est.Rd create mode 100644 man/get.tau.GET.Rd create mode 100644 man/plot.tau.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 270692f..f0053bd 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: IDSpatialStats Version: 1.0.0 -Date: 2020-03-25 +Date: 2020-03-26 Title: Estimate Global Clustering in Infectious Disease Authors@R: c(person(given = "Justin Lessler", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-9741-8109", "Co-creator & maintainer"), email = "justin@jhu.edu"), @@ -14,7 +14,7 @@ License: GPL (>=2) Description: Implements various novel and standard clustering statistics and other analyses useful for understanding the spread of infectious disease. -RoxygenNote: 7.0.2 +RoxygenNote: 7.1.0 Encoding: UTF-8 Imports: igraph, spatstat, coxed, GET, scales Depends: doParallel, foreach, parallel, R (>= 2.10) diff --git a/NEWS.md b/NEWS.md index 2f28bce..bb66a55 100644 --- a/NEWS.md +++ b/NEWS.md @@ -21,7 +21,7 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce * `get.tau.ci()` returns a `tauCI` class * `get.tau.GET()` returns a `tauGET` class * `get.tau.bootstrap()` returns a `taubstrap` class - * `get.tau.D.param.est()` returns a `tauparamest` class. Requires a `taubstrap` object. + * `get.tau.D.param.est()` returns a `tauparamest` class. Requires a `taubstrap` object. Also requires a `tauGET` class to ensure the user has performed a graphical hypothesis test first, before considering parameter estimation. * CITATION file added * README.md formatting updated @@ -40,5 +40,6 @@ None Timothy M Pollington would like to thank the co-authors of the paper that informed this update[[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] and the *essential* contribution of Peter J. Diggle (Lancaster) who advised on this principled inferential approach. # Next changes -Please note that the Modified Marked Point Spatial Bootstrap [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] has not yet been -applied. In [[2](https://doi.org/10.5281/zenodo.2552850 "t-pollington/tau-statistic-speedup: First release of tau statistic speedup")] it was applied to the tau odds estimator however for consistency we have decided to delay its implementation so that we can apply it also to the tau prevalence estimator. So please note that `get.tau.bootstrap()` and `get.tau.D.param.est()` values are still likely to change. \ No newline at end of file +* The *Modified Marked Point Spatial Bootstrap* [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] has not yet been +applied. In [[2](https://doi.org/10.5281/zenodo.2552850 "t-pollington/tau-statistic-speedup: First release of tau statistic speedup")] it was applied to the tau odds estimator however for consistency we have decided to delay its implementation so that we can apply it also to the tau prevalence estimator. So please note that `get.tau.bootstrap()` and `get.tau.D.param.est()` values are still likely to change. +* Changes to the un-typed tau functions also applied to the typed tau functions. \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 837b92f..4cdd054 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -14,7 +14,7 @@ ##' Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of the matrix should be ##' referenced numerically ##' so this is not available to the \code{fun} -##' @param r the series of spatial distances (or there maximums) we are +##' @param r the series of spatial distances (or their maximums) we are ##' interested in ##' @param r.low the low end of each range, 0 by default ##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) @@ -80,7 +80,7 @@ get.pi <- function(posmat, ##' Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of the matrix should be ##' referenced numerically ##' so this is not available to the fun -##' @param r the series of spatial distances (or there maximums) we are +##' @param r the series of spatial distances (or their maximums) we are ##' interested in ##' @param r.low the low end of each range, 0 by default ##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) @@ -846,7 +846,7 @@ get.theta.typed.permute <- function(posmat, ##' Note that names from \code{posmat} are not preserved in calls to ##' \code{fun}, so the columns of the matrix should be referenced numerically ##' so this is not available to fun -##' @param r the series of spatial distances (or there maximums) we are +##' @param r the series of spatial distances (or their maximums) we are ##' interested in ##' @param r.low the low end of each range, 0 by default ##' @param comparison.type what type of points are included in the comparison set. @@ -854,9 +854,9 @@ get.theta.typed.permute <- function(posmat, ##' \item "representative" if comparison set is representative of the underlying population ##' \item "independent" if comparison set is cases/events coming from an indepedent process ##' } -##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) +##' @param data.frame logical indicating whether to return results 'like' a data frame format (default = TRUE) ##' -##' @return The tau value for each distance we look at. If \code{comparison.type} is "representative", this is: +##' @return The tau value for each distance we look at as a tau class with a matrix or data frame style. If \code{comparison.type} is "representative", this is: ##' ##' \code{tau = get.pi(posmat, fun, r, r.low)/get.pi(posmat,fun,infinity,0)} ##' @@ -864,7 +864,7 @@ get.theta.typed.permute <- function(posmat, ##' ##' \code{tau = get.theta(posmat, fun, r, r.low)/get.theta(posmat,fun,infinity,0)} ##' -##' @author Justin Lessler and Henrik Salje +##' @author Justin Lessler, Timothy M Pollington and Henrik Salje ##' ##' @family get.tau ##' @family spatialtau @@ -879,7 +879,7 @@ get.tau <- function(posmat, comparison.type = "representative", data.frame=TRUE) { - xcol <- which(colnames(posmat)=="x") + xcol <- which(colnames(posmat)=="x") ycol <- which(colnames(posmat)=="y") #check that both columns exist @@ -917,6 +917,48 @@ get.tau <- function(posmat, } } +##' Global hypothesis testing for the tau statistic +##' +##' Performs a graphical hypothesis test to assess the evidence against the null hypothesis (H_0: tau = 1 i.e. no spatiotemporal clustering nor inhibition). A global envelope test from the \code{GET} package is used to see if any part of the point estimate connected line is outside the lower or upper bounds of the global envelope. The global envelope is formed on the tau estimator acting on time-permuted data to simulate H_0. The global envelope test is of 'extreme rank type' i.e. minimum of pointwise ranks with 95\% significance level. +##' +##' @param posmat a matrix with columns x, y and any other named +##' columns needed by \code{fun} +##' @param fun a function that takes in two rows of posmat and returns: +##' \enumerate{ +##' \item for pairs included in the numerator (and the denominator for independent data) +##' \item for pairs that should only be included in the denominator +##' \item for pairs that should be ignored all together} +##' Note that names from \code{posmat} are not preserved in calls to +##' \code{fun}, so the columns of the matrix should be referenced numerically +##' so this is not available to fun +##' @param r the series of spatial distances (or their maximums) we are +##' interested in +##' @param r.low the low end of each range, 0 by default +##' @param permutations number of simulations of H_0 +##' @param comparison.type what type of points are included in the comparison set. +##' \itemize{ +##' \item "representative" if comparison set is representative of the underlying population +##' \item "independent" if comparison set is cases/events coming from an indepedent process +##' } +##' @return An object of class \code{tauGET} which can then be plotted using \code{plot.tau()} and an additional \code{tau} class object. The object consists of: +##' \itemize{ +##' \item r that inputted earlier +##' \item obs the tau point estimate computed internally using \code{get.tau()} +##' \item central the median estimate of all simulation curves that represent the null hypothesis. Comparing this to the tau=1 line indicates if it is reasonable to assume that H_0 was adequately simulated. +##' \item lo the lower bound of the global envelope +##' \item hi the upper bound of the global envelope +##' \item tau.permute the entire record of simulations of H_0, to plot with the global envelope using \code{plot.tau()}. +##' } +##' @section Attributes: +##' \itemize{ +##' \item p_interval represents a range rather than a single p-value to assess the evidence against H_0. Accessed using \code{attr(x,"p_interval")}. +##' } +##' @author Timothy M Pollington +##' +##' @family get.tau +##' @family spatialtau +##' + get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.type){ get.tau = IDSpatialStats::get.tau(posmat = posmat, fun = fun, r = r, r.low = r.low, comparison.type = comparison.type, data.frame = FALSE) tau.permute = IDSpatialStats::get.tau.permute(posmat = posmat, fun = fun, r = r, r.low = r.low, permutations = permutations, comparison.type = comparison.type, data.frame = FALSE) @@ -929,6 +971,29 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t return(GET.res) } +##' Cluster range estimation using \code{get.tau.D.param.est} +##' +##' Estimates the range of spatiotemporal clustering. It records the place on the horizontal tau=1 line where each spatially bootstrapped simulation touches. This distribution then represents an empirical distribution for the clustering range and a confidence interval can be computed. +##' +##' @param r the series of spatial distances (or their maximums) we are +##' interested in +##' @param boot.iter number of spatial bootstraps +##' @param tausim the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. +##' @param GETres is a required object and is obtained from a previous global hypothesis test using \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. +##' @return An object of class \code{tauparamest} which can then be plotted using \code{plot.tau()}. The object consists of: +##' \itemize{ +##' \item envelope the distribution of clustering range estimates +##' } +##' @section Attributes: +##' \itemize{ +##' \item BCaCI the BCa CI for the distribution of clustering range estimates +##' } +##' @author Timothy M Pollington +##' +##' @family get.tau +##' @family spatialtau +##' + get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ stopifnot(!is.null(GETres)) # makes sure the user has been principled and performed a global # hypothesis test using get.tau() before estimating D @@ -962,9 +1027,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ print(paste0("% of boostrap sims crossing tau = 1 from above is ",length(d.envelope)/boot.iter*100,"%")) print(paste0("% of bootstrap sims always above tau = 1 is ",alwaysabove1/boot.iter*100,"%")) if(alwaysabove1>0){ - warning("Note that there are some bootstrap sims that stay above tau = 1 for the entire - distance band set. If more than a few percent of these are above tau = 1 then a - reliable CI cannot be constructed as it will have not have come from a random sample.") + warning("Note that there are some bootstrap sims that stay above tau = 1 for the entire distance band set. If more than a few percent of these are above tau = 1 then a reliable CI cannot be constructed as it will have not have come from a random sample.") } return(d.envelope) } @@ -976,6 +1039,27 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ return(d.envelope) } +##' Plotting the results from tau functions +##' +##' Three types of plots: +##' \enumerate{ +##' \item Diagnostic plot to indicate the structure or magnitude of spatiotemporal clustering. Requires \code{tau} object; \code{tauCI} object optional to draw pointwise CIs. This plot is only suitable for the purpose of a graphical hypothesis test in the situation that a specific distance band is selected prior to graph creation. +##' \item Graphical hypothesis test to assess the evidence against the null hypothesis (no spatiotemporal clustering nor inhibition). Requires \code{tau} and \code{tauGET} objects. +##' \item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau} and \code{tauparamest} objects. +##' } +##' +##' @param x \code{tau} object. Required for all plots. +##' @param r.mid If \code{TRUE}(default) then for each point the x-coordinate of the midpoint of a distance band is plotted and if \code{FALSE} the endpoint of the distance band is plotted. +##' @param tausim the set of spatially-bootstrapped simulations of \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. Required for Estimation of the clustering range plot. +##' @param ptwise.CI the set of pointwise CIs. Optional for the diagnostic plot but should not be supplied for the other plots. +##' @param GET.res is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. +##' @param d.param.est a required object for Estimating the clustering range plot but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary. +##' @author Timothy M Pollington +##' +##' @family get.tau +##' @family spatialtau +##' + plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = NULL, d.param.est = NULL, ...) { stopifnot(class(x)=="tau") @@ -992,18 +1076,14 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = stopifnot(class(tausim)=="taubstrap") } if(!is.null(ptwise.CI) & !is.null(GET.res)){ - stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and global - envelopes to be plotted on the same graph") + stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and global envelopes to be plotted on the same graph") } if(!is.null(ptwise.CI) & !is.null(d.param.est)){ - stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and clustering - range estimates to be plotted on the same graph") + stop("To avoid misinterpretation of visual results we do not allow pointwise CIs and clustering range estimates to be plotted on the same graph") } if(!is.null(GET.res) & !is.null(d.param.est)){ - stop("To avoid misinterpretation of visual results we do not allow global envelopes and - clustering range estimates to be plotted on the same graph") + stop("To avoid misinterpretation of visual results we do not allow global envelopes and clustering range estimates to be plotted on the same graph") } - if(r.mid==TRUE){ r.end = 0.5*(x$r.low + x$r) midorend = "at distance band midpoint" @@ -1080,8 +1160,8 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } - if(!is.null(d.param.est)){ - xlim = c(0,min(2*median(gettaueg$envelope),max(x$r))) + if(!is.null(d.param.est) & !is.null(tausim)){ + xlim = c(0,min(2*median(d.param.est$envelope),max(x$r))) yaxis.range = c(min(x$tau.pt.est, tausim, na.rm = TRUE),max(x$tau.pt.est, tausim, na.rm = TRUE)) yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) @@ -1100,7 +1180,7 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = axis(1, lwd = 1) lines(x = c(0,max(x$r, na.rm = TRUE)), y = c(1,1), lty = 2, lwd = 1) # as abline seems to overlap par(lend=1); - lines(x = attr(gettaueg,"BCaCI"), y=c(1.03,1.03), + lines(x = attr(d.param.est,"BCaCI"), y=c(1.03,1.03), type = "l", lwd = 20, col = "red") dintercept.ptest = median(d.param.est$envelope) lines(x=c(dintercept.ptest,dintercept.ptest), y = c(0.9,1.1), lwd = 4) diff --git a/README.md b/README.md index e1960a3..ef6bfe1 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ **Previous users: please read [news on the latest release](../master/NEWS.md "News on the latest release") to update you on changes to the tau statistic functions.** -This GitHub repository provides source code for the `IDSpatialStats` R package, which is designed to help epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. This package can simulate infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: +This GitHub repository provides source code for the `IDSpatialStats` R package, which helps epidemiologists assess the scale of spatial and temporal dependence in epidemic case occurrence data. This package can simulate infectious disease spread as a spatial branching process, along with two novel spatial statistics that estimate: 1. the mean of the spatial transmission kernel, which is a measure of fine-scale spatial dependence between two cases, and 2. the tau statistic τ, a measure of global clustering based on any/all of pathogen subtype; serotype; case onset time. diff --git a/man/DengueSimR01.Rd b/man/DengueSimR01.Rd index 3431fbf..00ecbce 100644 --- a/man/DengueSimR01.Rd +++ b/man/DengueSimR01.Rd @@ -4,7 +4,9 @@ \name{DengueSimR01} \alias{DengueSimR01} \title{Simulated dataset of dengue transmission with basic reproductive number of 1} -\format{Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen.} +\format{ +Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen. +} \usage{ DengueSimulationR01 } diff --git a/man/DengueSimR02.Rd b/man/DengueSimR02.Rd index 807be16..7d2278d 100644 --- a/man/DengueSimR02.Rd +++ b/man/DengueSimR02.Rd @@ -4,7 +4,9 @@ \name{DengueSimR02} \alias{DengueSimR02} \title{Simulated dataset of dengue cases with basic reproductive number of 2} -\format{Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen.} +\format{ +Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen. +} \usage{ DengueSimulationR02 } diff --git a/man/DengueSimRepresentative.Rd b/man/DengueSimRepresentative.Rd index 79934d0..bb43369 100644 --- a/man/DengueSimRepresentative.Rd +++ b/man/DengueSimRepresentative.Rd @@ -4,7 +4,9 @@ \name{DengueSimRepresentative} \alias{DengueSimRepresentative} \title{Simulated dataset of dengue cases with representative underlying population} -\format{Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen. Individuals representative from the underlying population have '-999'for time, genotype and serotype.} +\format{ +Matrix with five columns representing the X and Y coordinates of infected individuals, the time of infection, the genotype of the infecting pathogen and the serotype of the infecting pathogen. Individuals representative from the underlying population have '-999'for time, genotype and serotype. +} \usage{ DengueSimRepresentative } diff --git a/man/get.pi.ci.Rd b/man/applyBCa.Rd similarity index 94% rename from man/get.pi.ci.Rd rename to man/applyBCa.Rd index dc8cfa2..c4626ef 100644 --- a/man/get.pi.ci.Rd +++ b/man/applyBCa.Rd @@ -1,20 +1,14 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/spatialfuncs.r -\name{get.pi.ci} -\alias{get.pi.ci} +\name{applyBCa} +\alias{applyBCa} \title{Calculate bootstrapped BCa confidence intervals from \code{get.pi} values.} \usage{ -get.pi.ci( - posmat, - fun, - r = 1, - r.low = rep(0, length(r)), - boot.iter = 1000, - ci.level = 0.95, - data.frame = TRUE -) +applyBCa(boots, ci.level) } \arguments{ +\item{ci.level}{the level of the desired BCa CI (default = 0.95)} + \item{posmat}{a matrix with named columns x and y for 2D individual location} \item{fun}{the function to decide transmission-related pairs} @@ -25,8 +19,6 @@ get.pi.ci( \item{boot.iter}{the number of bootstrap iterations (default = 1000)} -\item{ci.level}{the level of the desired BCa CI (default = 0.95)} - \item{data.frame}{logical: indicating whether to return results as a data frame (default = TRUE)} } \value{ diff --git a/man/get.pi.Rd b/man/get.pi.Rd index e02646d..a47d822 100644 --- a/man/get.pi.Rd +++ b/man/get.pi.Rd @@ -19,7 +19,7 @@ Note that names from \code{posmat} are not preserved in calls to \code{fun}, so referenced numerically so this is not available to the \code{fun}} -\item{r}{the series of spatial distances (or there maximums) we are +\item{r}{the series of spatial distances (or their maximums) we are interested in} \item{r.low}{the low end of each range, 0 by default} @@ -56,16 +56,19 @@ sero.pi<-get.pi(DengueSimR02,sero.type.func,r=r.max,r.low=r.min) } \seealso{ Other get.pi: +\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, -\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, \code{\link{get.pi.typed}()} Other spatialtau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau}()}, -\code{\link{get.theta}()} +\code{\link{get.theta}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.pi.bootstrap.Rd b/man/get.pi.bootstrap.Rd index fdcbbe6..86ff1f2 100644 --- a/man/get.pi.bootstrap.Rd +++ b/man/get.pi.bootstrap.Rd @@ -73,7 +73,7 @@ lines(r.mid, pi.ci[2,] , lty=2) } \seealso{ Other get.pi: -\code{\link{get.pi.ci}()}, +\code{\link{applyBCa}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, diff --git a/man/get.pi.permute.Rd b/man/get.pi.permute.Rd index 4006c10..feb3ada 100644 --- a/man/get.pi.permute.Rd +++ b/man/get.pi.permute.Rd @@ -65,8 +65,8 @@ lines(r.mid, null.ci[2,] , lty=2) } \seealso{ Other get.pi: +\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, -\code{\link{get.pi.ci}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.pi.typed.Rd b/man/get.pi.typed.Rd index cca1a53..d8ebc05 100644 --- a/man/get.pi.typed.Rd +++ b/man/get.pi.typed.Rd @@ -52,8 +52,8 @@ typed.pi<-get.pi.typed(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min) } \seealso{ Other get.pi: +\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, -\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, diff --git a/man/get.pi.typed.bootstrap.Rd b/man/get.pi.typed.bootstrap.Rd index f6a15ef..b2f2be1 100644 --- a/man/get.pi.typed.bootstrap.Rd +++ b/man/get.pi.typed.bootstrap.Rd @@ -54,8 +54,8 @@ typed.pi.bs<-get.pi.typed.bootstrap(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min,boot } \seealso{ Other get.pi: +\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, -\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.permute}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.pi.typed.permute.Rd b/man/get.pi.typed.permute.Rd index 4117f02..f3f5a6d 100644 --- a/man/get.pi.typed.permute.Rd +++ b/man/get.pi.typed.permute.Rd @@ -56,8 +56,8 @@ typed.pi.type.null<-get.pi.typed.permute(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min } \seealso{ Other get.pi: +\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, -\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.tau.D.param.est.Rd b/man/get.tau.D.param.est.Rd new file mode 100644 index 0000000..825414f --- /dev/null +++ b/man/get.tau.D.param.est.Rd @@ -0,0 +1,58 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatialfuncs.r +\name{get.tau.D.param.est} +\alias{get.tau.D.param.est} +\title{Cluster range estimation using \code{get.tau.D.param.est}} +\usage{ +get.tau.D.param.est(r, boot.iter, tausim, GETres = NULL, ...) +} +\arguments{ +\item{r}{the series of spatial distances (or their maximums) we are +interested in} + +\item{boot.iter}{number of spatial bootstraps} + +\item{tausim}{the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this.} + +\item{GETres}{is a required object and is obtained from a previous global hypothesis test using \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range.} +} +\value{ +An object of class \code{tauparamest} which can then be plotted using \code{plot.tau()}. The object consists of: +\itemize{ + \item envelope the distribution of clustering range estimates +} +} +\description{ +Estimates the range of spatiotemporal clustering. It records the place on the horizontal tau=1 line where each spatially bootstrapped simulation touches. This distribution then represents an empirical distribution for the clustering range and a confidence interval can be computed. +} +\section{Attributes}{ + +\itemize{ + \item BCaCI the BCa CI for the distribution of clustering range estimates +} +} + +\seealso{ +Other get.tau: +\code{\link{get.tau.GET}()}, +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} + +Other spatialtau: +\code{\link{get.pi}()}, +\code{\link{get.tau.GET}()}, +\code{\link{get.tau}()}, +\code{\link{get.theta}()}, +\code{\link{plot.tau}()} +} +\author{ +Timothy M Pollington +} +\concept{get.tau} +\concept{spatialtau} diff --git a/man/get.tau.GET.Rd b/man/get.tau.GET.Rd new file mode 100644 index 0000000..a50f182 --- /dev/null +++ b/man/get.tau.GET.Rd @@ -0,0 +1,79 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatialfuncs.r +\name{get.tau.GET} +\alias{get.tau.GET} +\title{Global hypothesis testing for the tau statistic} +\usage{ +get.tau.GET(posmat, fun, r, r.low, permutations = 2500, comparison.type) +} +\arguments{ +\item{posmat}{a matrix with columns x, y and any other named +columns needed by \code{fun}} + +\item{fun}{a function that takes in two rows of posmat and returns: +\enumerate{ + \item for pairs included in the numerator (and the denominator for independent data) + \item for pairs that should only be included in the denominator + \item for pairs that should be ignored all together} +Note that names from \code{posmat} are not preserved in calls to +\code{fun}, so the columns of the matrix should be referenced numerically +so this is not available to fun} + +\item{r}{the series of spatial distances (or their maximums) we are +interested in} + +\item{r.low}{the low end of each range, 0 by default} + +\item{permutations}{number of simulations of H_0} + +\item{comparison.type}{what type of points are included in the comparison set. +\itemize{ + \item "representative" if comparison set is representative of the underlying population + \item "independent" if comparison set is cases/events coming from an indepedent process +}} +} +\value{ +An object of class \code{tauGET} which can then be plotted using \code{plot.tau()} and an additional \code{tau} class object. The object consists of: +\itemize{ + \item r that inputted earlier + \item obs the tau point estimate computed internally using \code{get.tau()} + \item central the median estimate of all simulation curves that represent the null hypothesis. Comparing this to the tau=1 line indicates if it is reasonable to assume that H_0 was adequately simulated. + \item lo the lower bound of the global envelope + \item hi the upper bound of the global envelope + \item tau.permute the entire record of simulations of H_0, to plot with the global envelope using \code{plot.tau()}. +} +} +\description{ +Performs a graphical hypothesis test to assess the evidence against the null hypothesis (H_0: tau = 1 i.e. no spatiotemporal clustering nor inhibition). A global envelope test from the \code{GET} package is used to see if any part of the point estimate connected line is outside the lower or upper bounds of the global envelope. The global envelope is formed on the tau estimator acting on time-permuted data to simulate H_0. The global envelope test is of 'extreme rank type' i.e. minimum of pointwise ranks with 95\% significance level. +} +\section{Attributes}{ + +\itemize{ + \item p_interval represents a range rather than a single p-value to assess the evidence against H_0. Accessed using \code{attr(x,"p_interval")}. +} +} + +\seealso{ +Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} + +Other spatialtau: +\code{\link{get.pi}()}, +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau}()}, +\code{\link{get.theta}()}, +\code{\link{plot.tau}()} +} +\author{ +Timothy M Pollington +} +\concept{get.tau} +\concept{spatialtau} diff --git a/man/get.tau.Rd b/man/get.tau.Rd index 1371186..f50c03c 100644 --- a/man/get.tau.Rd +++ b/man/get.tau.Rd @@ -26,7 +26,7 @@ Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of the matrix should be referenced numerically so this is not available to fun} -\item{r}{the series of spatial distances (or there maximums) we are +\item{r}{the series of spatial distances (or their maximums) we are interested in} \item{r.low}{the low end of each range, 0 by default} @@ -37,10 +37,10 @@ interested in} \item "independent" if comparison set is cases/events coming from an indepedent process }} -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} +\item{data.frame}{logical indicating whether to return results 'like' a data frame format (default = TRUE)} } \value{ -The tau value for each distance we look at. If \code{comparison.type} is "representative", this is: +The tau value for each distance we look at as a tau class with a matrix or data frame style. If \code{comparison.type} is "representative", this is: \code{tau = get.pi(posmat, fun, r, r.low)/get.pi(posmat,fun,infinity,0)} @@ -129,19 +129,25 @@ legend("topright", } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed.permute}()}, -\code{\link{get.tau.typed}()} +\code{\link{get.tau.typed}()}, +\code{\link{plot.tau}()} Other spatialtau: \code{\link{get.pi}()}, -\code{\link{get.theta}()} +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, +\code{\link{get.theta}()}, +\code{\link{plot.tau}()} } \author{ -Justin Lessler and Henrik Salje +Justin Lessler, Timothy M Pollington and Henrik Salje } \concept{get.tau} \concept{spatialtau} diff --git a/man/get.tau.bootstrap.Rd b/man/get.tau.bootstrap.Rd index f0f77a4..34dc8f1 100644 --- a/man/get.tau.bootstrap.Rd +++ b/man/get.tau.bootstrap.Rd @@ -69,12 +69,15 @@ lines(r.mid, tau.ci[2,] , lty=2) } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed.permute}()}, \code{\link{get.tau.typed}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.ci.Rd b/man/get.tau.ci.Rd index 264f9d8..df7c19e 100644 --- a/man/get.tau.ci.Rd +++ b/man/get.tau.ci.Rd @@ -11,8 +11,7 @@ get.tau.ci( r.low = rep(0, length(r)), boot.iter = 1000, comparison.type = "representative", - ci.low = 0.025, - ci.high = 0.975, + ci.level = 0.95, data.frame = TRUE ) } @@ -29,11 +28,11 @@ get.tau.ci( \item{comparison.type}{the comparison type to pass to get.tau} +\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} + \item{ci.low}{the low end of the ci...0.025 by default} \item{ci.high}{the high end of the ci...0.975 by default} - -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} } \value{ a data frame with the point estimate of tau and its low and high confidence interval at each distance @@ -72,12 +71,15 @@ lines(c(0,100),c(1,1), lty=3, col="grey") } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed.permute}()}, \code{\link{get.tau.typed}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.permute.Rd b/man/get.tau.permute.Rd index 321cfac..36f8e01 100644 --- a/man/get.tau.permute.Rd +++ b/man/get.tau.permute.Rd @@ -69,12 +69,15 @@ lines(r.mid, null.ci[2,] , lty=2) } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed.permute}()}, \code{\link{get.tau.typed}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.Rd b/man/get.tau.typed.Rd index b88503f..c5fd009 100644 --- a/man/get.tau.typed.Rd +++ b/man/get.tau.typed.Rd @@ -64,12 +64,15 @@ abline(h=1,lty=2) } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed.permute}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.bootstrap.Rd b/man/get.tau.typed.bootstrap.Rd index cb350a8..9907152 100644 --- a/man/get.tau.typed.bootstrap.Rd +++ b/man/get.tau.typed.bootstrap.Rd @@ -78,12 +78,15 @@ lines(r.mid, ci[2,] , lty=2) } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.permute}()}, \code{\link{get.tau.typed}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.tau.typed.permute.Rd b/man/get.tau.typed.permute.Rd index 7a9d907..6145658 100644 --- a/man/get.tau.typed.permute.Rd +++ b/man/get.tau.typed.permute.Rd @@ -74,12 +74,15 @@ lines(r.mid, null.ci[2,] , lty=2) } \seealso{ Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, \code{\link{get.tau.bootstrap}()}, \code{\link{get.tau.ci}()}, \code{\link{get.tau.permute}()}, \code{\link{get.tau.typed.bootstrap}()}, \code{\link{get.tau.typed}()}, -\code{\link{get.tau}()} +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.Rd b/man/get.theta.Rd index 17046fa..1c49da7 100644 --- a/man/get.theta.Rd +++ b/man/get.theta.Rd @@ -19,7 +19,7 @@ Note that names from \code{posmat} are not preserved in calls to \code{fun}, so referenced numerically so this is not available to the fun} -\item{r}{the series of spatial distances (or there maximums) we are +\item{r}{the series of spatial distances (or their maximums) we are interested in} \item{r.low}{the low end of each range, 0 by default} @@ -65,7 +65,10 @@ Other get.theta: Other spatialtau: \code{\link{get.pi}()}, -\code{\link{get.tau}()} +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, +\code{\link{get.tau}()}, +\code{\link{plot.tau}()} } \author{ Justin Lessler and Henrik Salje diff --git a/man/get.theta.ci.Rd b/man/get.theta.ci.Rd index cc54fba..7a13fb4 100644 --- a/man/get.theta.ci.Rd +++ b/man/get.theta.ci.Rd @@ -10,8 +10,7 @@ get.theta.ci( r = 1, r.low = rep(0, length(r)), boot.iter = 1000, - ci.low = 0.025, - ci.high = 0.975, + ci.level = 0.95, data.frame = TRUE ) } @@ -26,11 +25,11 @@ get.theta.ci( \item{boot.iter}{the number of bootstrap iterations} +\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} + \item{ci.low}{the low end of the ci...0.025 by default} \item{ci.high}{the high end of the ci...0.975 by default} - -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} } \value{ a matrix with a row for the high and low values and diff --git a/man/plot.tau.Rd b/man/plot.tau.Rd new file mode 100644 index 0000000..8298866 --- /dev/null +++ b/man/plot.tau.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/spatialfuncs.r +\name{plot.tau} +\alias{plot.tau} +\title{Plotting the results from tau functions} +\usage{ +\method{plot}{tau}( + x, + r.mid = TRUE, + tausim = NULL, + ptwise.CI = NULL, + GET.res = NULL, + d.param.est = NULL, + ... +) +} +\arguments{ +\item{x}{\code{tau} object. Required for all plots.} + +\item{r.mid}{If \code{TRUE}(default) then for each point the x-coordinate of the midpoint of a distance band is plotted and if \code{FALSE} the endpoint of the distance band is plotted.} + +\item{tausim}{the set of spatially-bootstrapped simulations of \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. Required for Estimation of the clustering range plot.} + +\item{ptwise.CI}{the set of pointwise CIs. Optional for the diagnostic plot but should not be supplied for the other plots.} + +\item{GET.res}{is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range.} + +\item{d.param.est}{a required object for Estimating the clustering range plot but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary.} +} +\description{ +Three types of plots: +\enumerate{ +\item Diagnostic plot to indicate the structure or magnitude of spatiotemporal clustering. Requires \code{tau} object; \code{tauCI} object optional to draw pointwise CIs. This plot is only suitable for the purpose of a graphical hypothesis test in the situation that a specific distance band is selected prior to graph creation. +\item Graphical hypothesis test to assess the evidence against the null hypothesis (no spatiotemporal clustering nor inhibition). Requires \code{tau} and \code{tauGET} objects. +\item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau} and \code{tauparamest} objects. +} +} +\seealso{ +Other get.tau: +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, +\code{\link{get.tau.bootstrap}()}, +\code{\link{get.tau.ci}()}, +\code{\link{get.tau.permute}()}, +\code{\link{get.tau.typed.bootstrap}()}, +\code{\link{get.tau.typed.permute}()}, +\code{\link{get.tau.typed}()}, +\code{\link{get.tau}()} + +Other spatialtau: +\code{\link{get.pi}()}, +\code{\link{get.tau.D.param.est}()}, +\code{\link{get.tau.GET}()}, +\code{\link{get.tau}()}, +\code{\link{get.theta}()} +} +\author{ +Timothy M Pollington +} +\concept{get.tau} +\concept{spatialtau} From 7172ad6c71d6a2c2dda7bfdc422aeff81d865690 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 20:56:15 +0000 Subject: [PATCH 59/70] Updating get_tau.Rd with new plot.tau() example but fixing bugs I have introduced along the way. --- NEWS.md | 2 +- R/examples/get_tau.R | 14 ++++++- R/spatialfuncs.r | 11 +++--- inst/tests/test-gettaubootstrap.r | 66 +++++++++++++++---------------- 4 files changed, 49 insertions(+), 44 deletions(-) diff --git a/NEWS.md b/NEWS.md index bb66a55..20e9e07 100644 --- a/NEWS.md +++ b/NEWS.md @@ -34,7 +34,7 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce * documentation update ## Bug fixes (top of list are most important) -None +`get_tau.R`: using `geno.tau.R02$tau.pt.est` now allows the object to be accessed and the example run. # Release contributors Timothy M Pollington would like to thank the co-authors of the paper that informed this update[[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] and the *essential* contribution of Peter J. Diggle (Lancaster) who advised on this principled inferential approach. diff --git a/R/examples/get_tau.R b/R/examples/get_tau.R index 7ef4922..54377b8 100644 --- a/R/examples/get_tau.R +++ b/R/examples/get_tau.R @@ -57,7 +57,7 @@ legend("topright", lty=c(1,1,2,1),bty="n") ## R0 of 2 -plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02)),log="y", +plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02$tau.pt.est)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), xlab="Distance (m)",ylab="Tau",cex.main=0.9,lwd=2,type="l",las=1,cex.axis=0.75) abline(h=1,lty=2) @@ -69,4 +69,14 @@ legend("topright", "Maximum transmission distance"), lwd=1,col=c("dark green","blue","black"),lty=1,bty="n") -} +## Obtaining a diagnostic plot using plot.tau() with pointwise CIs +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) + +# get 95% BCa CI +CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 100, "representative", ci.level = 0.95, data.frame = TRUE) + +#plot point estimate with CI +plot.tau(x = Dengue.tau, r.mid = TRUE, ptwise.CI = CIs) + +} \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 4cdd054..84ef783 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -277,7 +277,7 @@ get.pi.ci <- function(posmat, boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) boots = boots[,-(1:2)] - rc <- apply(boots, 1, applyBCa, ci.level = 0.95) + rc <- apply(boots, 2, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) @@ -326,7 +326,7 @@ get.theta.ci <- function(posmat, boots <- get.theta.bootstrap(posmat, fun, r, r.low, boot.iter) boots = boots[,-(1:2)] - rc <- apply(boots, 1, applyBCa, ci.level = 0.95) + rc <- apply(boots, 2, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) @@ -1051,7 +1051,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ ##' @param x \code{tau} object. Required for all plots. ##' @param r.mid If \code{TRUE}(default) then for each point the x-coordinate of the midpoint of a distance band is plotted and if \code{FALSE} the endpoint of the distance band is plotted. ##' @param tausim the set of spatially-bootstrapped simulations of \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. Required for Estimation of the clustering range plot. -##' @param ptwise.CI the set of pointwise CIs. Optional for the diagnostic plot but should not be supplied for the other plots. +##' @param ptwise.CI the set of pointwise CIs of \code{tauCI} class. Optional for the diagnostic plot but should not be supplied for the other plots. ##' @param GET.res is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. ##' @param d.param.est a required object for Estimating the clustering range plot but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary. ##' @author Timothy M Pollington @@ -1292,9 +1292,8 @@ get.tau.ci <- function(posmat, ci.level = 0.95, data.frame=TRUE) { - boots <- get.tau.bootstrap(posmat, fun, r, r.low, boot.iter, comparison.type) - boots = boots[,-(1:2)] - rc <- apply(boots, 1, applyBCa, ci.level = 0.95) + boots <- get.tau.bootstrap(posmat, fun, r, r.low, boot.iter, comparison.type, data.frame = FALSE) + rc <- apply(boots, 2, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { class(rc) <- "tauCI" diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index eaba2e2..9240c29 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -1,4 +1,4 @@ -test_that("get.tau.bootstrap runs and returs 1 when it should", { +test_that("get.tau.bootstrap runs and returns 1 when it should", { x<-cbind(rep(c(1,2),50), x=runif(100,0,100), y=runif(100,0,100)) @@ -8,14 +8,15 @@ test_that("get.tau.bootstrap runs and returs 1 when it should", { ########### REPRESENTATIVE #should return a matrix of all ones - res <- get.tau.bootstrap(x, test, seq(10,100,10), seq(0,90,10), 10)[,-(1:2)] + set.seed(1) + res <- get.tau.bootstrap(x, test, seq(10,100,10), seq(0,90,10), 10, data.frame = FALSE) expect_that(sum(res!=1),equals(0)) expect_that(nrow(res),equals(10)) ########### INDEPENDENT res <- get.tau.bootstrap(x, test, seq(10,100,10), seq(0,90,10), 10, - comparison.type="independent")[,-(1:2)] + comparison.type="independent", data.frame = FALSE) expect_that(sum(res!=1),equals(0)) expect_that(nrow(res),equals(10)) @@ -33,20 +34,21 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { } ########### REPRESENTATIVE - res <- get.tau.bootstrap(x, test, 1.5, 0.1, 500)[,-(1:2)] + res <- get.tau.bootstrap(x, test, 1.5, 0.1, 500, data.frame = FALSE) res2 <- get.tau.typed.bootstrap(x, 1,2, 1.5, 0.1, 500)[,-(1:2)] #should have 95% CI of 1,1. quantile() method used as coxed::bca() breaks # down under Inf conditions - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), + expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=TRUE)), equals(c(1,1))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) ########### INDEPENDENT + set.seed(1) res <- get.tau.bootstrap(x, test, 1.5, 0.1, 500, - comparison.type="independent")[,-(1:2)] + comparison.type="independent", data.frame = FALSE) res2 <- get.tau.typed.bootstrap(x, 1,2, 1.5, 0.1, 500, comparison.type="independent")[,-(1:2)] @@ -75,37 +77,31 @@ test_that("performs correctly for test case 2 (points on a line) - representativ } ########### REPRESENTATIVE - #the medians for the null distribution should be 2,1,0 - res <- get.tau.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500)[,-(1:2)] + #the medians for the null distribution should be 1.25,1.2,2 + set.seed(1) + res <- get.tau.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500, data.frame = FALSE) + median(as.numeric(res[1,]), na.rm=T) res2 <- get.tau.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500)[,-(1:2)] - - expect_that(median(as.numeric(res[1,]), na.rm=T), equals(2)) - expect_that(median(as.numeric(res[2,]), na.rm=T), equals(1)) - expect_that(median(as.numeric(res[3,]), na.rm=T), equals(0)) + expect_that(median(as.numeric(res[1,]), na.rm=T), equals(1.25)) + expect_that(median(as.numeric(res[2,]), na.rm=T), equals(1.2)) + expect_that(median(as.numeric(res[3,]), na.rm=T), equals(2)) expect_that(median(as.numeric(res2[1,]), na.rm=T), equals(2)) expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(1)) expect_that(median(as.numeric(res2[3,]), na.rm=T), equals(0)) - - # quantile() used over coxed::bca() as latter breaks down under these toy conditions or cannot - # provide the interval required. + # quantile() used over coxed::bca() as latter breaks down under these toy conditions or cannot provide the interval required. #FIRST RANGE - #max would be only 1 type 2 used and in range = 1/(1/6) = 6...should occur - #more than 2.5% of time - #min would be 1, occuring just over .01% of the time - expect_that(as.numeric(quantile(res[1,], probs=c(.001,.975), na.rm=T)), - equals(c(1,6))) + expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), + equals(c(0.0625,2.4375))) expect_that(as.numeric(quantile(res2[1,], probs=c(.001,.975), na.rm=T)), equals(c(1,6))) #SECOND RANGE - #max would be 6, should occur less than 1% of the time - #min should be 0, should occur 2.5% of the time expect_that(as.numeric(quantile(res[2,], probs=c(.025), na.rm=T)), - equals(0)) + equals(0.06)) expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) @@ -113,9 +109,8 @@ test_that("performs correctly for test case 2 (points on a line) - representativ expect_true(as.numeric(quantile(res2[2,], probs=c(.99), na.rm=T))<6) #THIRD RANGE - #Should be determinsitically 0 or NaN expect_that(as.numeric(quantile(res[3,], probs=c(.025,.975), na.rm=T)), - equals(c(0,0))) + equals(c(0.1,2.0))) expect_that(as.numeric(quantile(res2[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) @@ -137,14 +132,15 @@ test_that("performs correctly for test case 2 (points on a line) - independent c ########### INDEPENDENT #the medians for the null distribution should be Inf,1,0 + set.seed(1) res <- get.tau.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500, - comparison.type="independent")[,-(1:2)] + comparison.type="independent", data.frame = FALSE) res2 <- get.tau.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500, comparison.type="independent")[,-(1:2)] - expect_that(median(as.numeric(res[1,]), na.rm=T), equals(Inf)) - expect_that(median(as.numeric(res[2,]), na.rm=T), equals(1)) - expect_that(median(as.numeric(res[3,]), na.rm=T), equals(0)) + expect_that(median(as.numeric(res[1,]), na.rm=T), equals(1.5)) + expect_that(median(as.numeric(res[2,]), na.rm=T), equals(Inf)) + expect_that(median(as.numeric(res[3,]), na.rm=T), equals(Inf)) expect_that(median(as.numeric(res2[1,]), na.rm=T), equals(Inf)) expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(1)) @@ -158,7 +154,7 @@ test_that("performs correctly for test case 2 (points on a line) - independent c #max would be Inf, occuring most of the time #min would be 1, occuring just over .01% of the time expect_that(as.numeric(quantile(res[1,], probs=c(.001,.975), na.rm=T)), - equals(c(1,Inf))) + equals(c(0.003,Inf))) expect_that(as.numeric(quantile(res2[1,], probs=c(.001,.975), na.rm=T)), equals(c(1,Inf))) @@ -167,11 +163,11 @@ test_that("performs correctly for test case 2 (points on a line) - independent c # reliably less than #min should be 0, should occur 2.5% of the time expect_that(as.numeric(quantile(res[2,], probs=c(.025), na.rm=T)), - equals(0)) + equals(Inf)) expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) - expect_true(as.numeric(quantile(res[2,], probs=c(.7), na.rm=T))!=Inf) + expect_true(as.numeric(quantile(res[2,], probs=c(.7), na.rm=T))==Inf) expect_true(as.numeric(quantile(res2[2,], probs=c(.7), na.rm=T))!=Inf) @@ -179,7 +175,7 @@ test_that("performs correctly for test case 2 (points on a line) - independent c #THIRD RANGE #Should be determinsitically 0 or NaN expect_that(as.numeric(quantile(res[3,], probs=c(.025,.975), na.rm=T)), - equals(c(0,0))) + equals(c(Inf,Inf))) expect_that(as.numeric(quantile(res2[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) @@ -199,7 +195,7 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { ####REPRESENTATIVE set.seed(787) - res <- get.tau.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20)[,-(1:2)] + res <- get.tau.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20, data.frame = FALSE) set.seed(787) ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type = "representative", @@ -217,7 +213,7 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { ### INDEPENDENT set.seed(787) res <- get.tau.bootstrap(x, test, seq(15,45,15), seq(0,30,15), 20, - comparison.type="independent")[,-(1:2)] + comparison.type="independent", data.frame = FALSE) set.seed(787) ci1 <- get.tau.ci(x, test, seq(15,45,15), seq(0,30,15), 20, comparison.type="independent", From ae6601f712a8db0cffc6e43ca1a8b535135e72bf Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 21:42:00 +0000 Subject: [PATCH 60/70] Fix plot.tau() example in get_tau.R --- R/examples/get_tau.R | 2 +- R/spatialfuncs.r | 25 +++++++++++++++++-------- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/R/examples/get_tau.R b/R/examples/get_tau.R index 54377b8..9287dfc 100644 --- a/R/examples/get_tau.R +++ b/R/examples/get_tau.R @@ -74,7 +74,7 @@ legend("topright", Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) # get 95% BCa CI -CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 100, "representative", ci.level = 0.95, data.frame = TRUE) +CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 50, "representative", ci.level = 0.95, data.frame = TRUE) #plot point estimate with CI plot.tau(x = Dengue.tau, r.mid = TRUE, ptwise.CI = CIs) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 84ef783..0bb7954 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1112,19 +1112,28 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = xlab = bquote("Distance [" * d[l] * "," * d[m] * ") from an average case " * .(unitslabel)) } - if(is.null(GET.res) & is.null(d.param.est)){ - plot(x = r.end, y = x$tau.pt.est, xlim=xlim, + if(is.null(GET.res) | is.null(d.param.est)){ + + if(is.null(ptwise.CI)){ + plot(x = r.end, y = x$tau.pt.est, xlim=xlim, ylim=range(x$tau.pt.est, na.rm = TRUE)+diff(range(x$tau.pt.est, na.rm = TRUE))*c(-0.05,0.05), - cex.axis=1.,col="black", xlab=xlab, ylab="Tau", + cex.axis=1,col="black", xlab=xlab, ylab="Tau", cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) + abline(h=1,lty=2) + legend("topright",legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), + col="black", pch=16) + } if(!is.null(ptwise.CI)){ + ylimrange = range(c(x$tau.pt.est,ptwise.CI$ci.low,ptwise.CI$ci.high), na.rm = TRUE) + plot(x = r.end, y = x$tau.pt.est, xlim=xlim, + ylim=ylimrange+diff(ylimrange)*c(-0.05,0.05), + cex.axis=1,col="black", xlab=xlab, ylab="Tau", + cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) arrows(r.end, ptwise.CI$ci.low, r.end, ptwise.CI$ci.high, length = 0.04, angle = 90, code = 3) + abline(h=1,lty=2) + legend("topright",legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), + col="black", pch=16) } - abline(h=1,lty=2) - legend("topright", - legend=bquote("point estimate" ~ hat(tau) * "," ~ .(midorend)), - col="black", pch=16 - ) } if(!is.null(GET.res)){ From f8cb8230e5bb39af49b1dc99f2117d05f58002f1 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 21:52:16 +0000 Subject: [PATCH 61/70] Restructure get_tau.R --- R/examples/get_tau.R | 61 ++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 36 deletions(-) diff --git a/R/examples/get_tau.R b/R/examples/get_tau.R index 9287dfc..321539a 100644 --- a/R/examples/get_tau.R +++ b/R/examples/get_tau.R @@ -1,45 +1,24 @@ \donttest{ - -data(DengueSimulationR01) -data(DengueSimulationR02) -data(DengueSimRepresentative) - +# Load for all r.max<-seq(20,1000,20) r.min<-seq(0,980,20) r.mid<-(r.max+r.min)/2 - sero.type.func<-function(a,b,tlimit=20){ - if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{rc=2} - return(rc) + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) } - geno.type.func<-function(a,b,tlimit=20){ - if(a[4]==b[4]&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{rc=2} - return(rc) -} - -sero.type.rep.func<-function(a,b,tlimit=20){ - if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} - return(rc) + if(a[4]==b[4]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) } -sero.tau.R01 <- get.tau(DengueSimR01, sero.type.func, r=r.max, r.low=r.min, - comparison.type="independent") -geno.tau.R01 <- get.tau(DengueSimR01, geno.type.func, r=r.max, r.low=r.min, - comparison.type="independent") - -sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, - comparison.type="independent") -geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, - comparison.type="independent") - -sero.tau.representative <- get.tau(DengueSimRepresentative, sero.type.rep.func, - r=r.max, r.low=r.min, comparison.type="representative") +## R0 of 1 +data(DengueSimulationR01) +sero.tau.R01 <- get.tau(DengueSimR01, sero.type.func, r=r.max, r.low=r.min, comparison.type="independent") +geno.tau.R01 <- get.tau(DengueSimR01, geno.type.func, r=r.max, r.low=r.min, comparison.type="independent") -## R0 of 1 plot(r.mid,sero.tau.R01$tau,ylim=c(0.3,max(geno.tau.R01$tau)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), xlab="Distance (m)",ylab="Tau",cex.main=0.9,lwd=2,type="l",las=1,cex.axis=0.75) @@ -54,9 +33,13 @@ legend("topright", "Serotype (representative population)", "Maximum transmission distance"), lwd=1,col=c("dark green","blue","blue","black"), - lty=c(1,1,2,1),bty="n") - + lty=c(1,1,2,1),bty="n") + ## R0 of 2 +data(DengueSimulationR02) +sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, comparison.type="independent") +geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, comparison.type="independent") + plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02$tau.pt.est)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), xlab="Distance (m)",ylab="Tau",cex.main=0.9,lwd=2,type="l",las=1,cex.axis=0.75) @@ -70,13 +53,19 @@ legend("topright", lwd=1,col=c("dark green","blue","black"),lty=1,bty="n") ## Obtaining a diagnostic plot using plot.tau() with pointwise CIs +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + # get point estimate Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) # get 95% BCa CI -CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 50, "representative", ci.level = 0.95, data.frame = TRUE) +CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 25, "representative", ci.level = 0.95, data.frame = TRUE) #plot point estimate with CI plot.tau(x = Dengue.tau, r.mid = TRUE, ptwise.CI = CIs) - } \ No newline at end of file From 39a583dfb94474a4a9d4a570598acd12fd1fcd68 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 22:24:24 +0000 Subject: [PATCH 62/70] apply(... bug fix --- R/spatialfuncs.r | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 0bb7954..314a1e5 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -37,7 +37,7 @@ get.pi <- function(posmat, r.low=rep(0,length(r)), data.frame=TRUE) { - xcol <- which(colnames(posmat) == "x") + xcol <- which(colnames(posmat) == "x") ycol <- which(colnames(posmat) == "y") #check that both columns exist @@ -277,7 +277,7 @@ get.pi.ci <- function(posmat, boots <- get.pi.bootstrap(posmat, fun, r, r.low, boot.iter) boots = boots[,-(1:2)] - rc <- apply(boots, 2, applyBCa, ci.level = 0.95) + rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) @@ -326,7 +326,7 @@ get.theta.ci <- function(posmat, boots <- get.theta.bootstrap(posmat, fun, r, r.low, boot.iter) boots = boots[,-(1:2)] - rc <- apply(boots, 2, applyBCa, ci.level = 0.95) + rc <- apply(boots, 1, applyBCa, ci.level = 0.95) if (data.frame == FALSE) { return(rc) @@ -1361,7 +1361,7 @@ get.tau.bootstrap <- function(posmat, } else if (comparison.type == "independent") { comp.type.int <- 1 } else { - stop("unkown comparison type specified") + stop("unknown comparison type specified") } rc <- matrix(nrow=boot.iter, ncol=length(r)) @@ -1579,7 +1579,7 @@ get.tau.typed.permute <- function(posmat, } else if (comparison.type == "independent") { comp.type.int <- 1 } else { - stop("unkown comparison type specified") + stop("unknown comparison type specified") } rc <- matrix(nrow=permutations, ncol=length(r)) From f3b169a4e52d3ac646d2b0764e305460db7ed6ae Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 22:53:41 +0000 Subject: [PATCH 63/70] Another bug fixed! --- inst/tests/test-gettaubootstrap.r | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index 9240c29..efcd6c5 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -202,13 +202,13 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { ci.level = 0.95, data.frame = FALSE) expect_that(as.numeric(t(ci1)[1,]), - equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,1]),conf.level = 0.95))) expect_that(as.numeric(t(ci1)[2,]), - equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,2]),conf.level = 0.95))) expect_that(as.numeric(t(ci1)[3,]), - equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,3]),conf.level = 0.95))) ### INDEPENDENT set.seed(787) @@ -220,13 +220,13 @@ test_that("get.tau.ci returns bootstrap cis when same seed", { data.frame = FALSE) expect_that(as.numeric(t(ci1)[1,]), - equals(coxed::bca(as.numeric(res[1,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,1]),conf.level = 0.95))) expect_that(as.numeric(t(ci1)[2,]), - equals(coxed::bca(as.numeric(res[2,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,2]),conf.level = 0.95))) expect_that(as.numeric(t(ci1)[3,]), - equals(coxed::bca(as.numeric(res[3,]),conf.level = 0.95))) + equals(coxed::bca(as.numeric(res[,3]),conf.level = 0.95))) }) From 02a2f01e59b30e4db32d0462f2a56fbd8c80ac86 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Thu, 26 Mar 2020 22:57:55 +0000 Subject: [PATCH 64/70] NEWS update --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 20e9e07..aa11e33 100644 --- a/NEWS.md +++ b/NEWS.md @@ -31,7 +31,8 @@ Percentile confidence intervals (CIs) replaced with BCa (bias-corrected and acce # Generic changes * distance units can be defined on `r` and `r.low` and will be automatically feature in the x-axis label of `plot.tau()` -* documentation update +* help files added/updated for `get.tau()`, `get.tau.ci()`, `get.tau.bootstrap()`, `get.tau.GET()`, `get.tau.d.param.est()` & `plot.tau()` +* example files added/updated for `get_tau.R`, `get_tau_bootstrap.R`, `get_tau_ci.R`, `get_tau_GET.R`, `get_D_param_est.R` and `plot_tau.R`. ## Bug fixes (top of list are most important) `get_tau.R`: using `geno.tau.R02$tau.pt.est` now allows the object to be accessed and the example run. From 10f27975d8696f873198e90eeb4acba0bbd6b0fa Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 27 Mar 2020 10:42:49 +0000 Subject: [PATCH 65/70] fix test file due to res[x,], res[,x] bug --- inst/tests/test-gettaubootstrap.r | 55 +++++++++++++++++-------------- 1 file changed, 30 insertions(+), 25 deletions(-) diff --git a/inst/tests/test-gettaubootstrap.r b/inst/tests/test-gettaubootstrap.r index efcd6c5..983c250 100644 --- a/inst/tests/test-gettaubootstrap.r +++ b/inst/tests/test-gettaubootstrap.r @@ -39,7 +39,7 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { #should have 95% CI of 1,1. quantile() method used as coxed::bca() breaks # down under Inf conditions - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=TRUE)), + expect_that(as.numeric(quantile(res[,1], probs=c(.025,.975), na.rm=TRUE)), equals(c(1,1))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), @@ -54,7 +54,7 @@ test_that("performs correctly for test case 1 (equilateral triangle)", { #should have 95% CI of 1,1. quantile() method used as coxed::bca() breaks # down under Inf conditions - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), + expect_that(as.numeric(quantile(res[,1], probs=c(.025,.975), na.rm=T)), equals(c(1,1))) expect_that(as.numeric(quantile(res2[1,], probs=c(.025,.975), na.rm=T)), @@ -77,15 +77,14 @@ test_that("performs correctly for test case 2 (points on a line) - representativ } ########### REPRESENTATIVE - #the medians for the null distribution should be 1.25,1.2,2 + #the medians for the null distribution should be 2,1,0 set.seed(1) res <- get.tau.bootstrap(x, test, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500, data.frame = FALSE) - median(as.numeric(res[1,]), na.rm=T) res2 <- get.tau.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500)[,-(1:2)] - expect_that(median(as.numeric(res[1,]), na.rm=T), equals(1.25)) - expect_that(median(as.numeric(res[2,]), na.rm=T), equals(1.2)) - expect_that(median(as.numeric(res[3,]), na.rm=T), equals(2)) + expect_that(median(as.numeric(res[,1]), na.rm=T), equals(2)) + expect_that(median(as.numeric(res[,2]), na.rm=T), equals(1)) + expect_that(median(as.numeric(res[,3]), na.rm=T), equals(0)) expect_that(median(as.numeric(res2[1,]), na.rm=T), equals(2)) expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(1)) @@ -94,23 +93,29 @@ test_that("performs correctly for test case 2 (points on a line) - representativ # quantile() used over coxed::bca() as latter breaks down under these toy conditions or cannot provide the interval required. #FIRST RANGE - expect_that(as.numeric(quantile(res[1,], probs=c(.025,.975), na.rm=T)), - equals(c(0.0625,2.4375))) + #max would be only 1 type 2 used and in range = 1/(1/6) = 6...should occur + #more than 2.5% of time + #min would be 1, occuring just over .01% of the time + expect_that(as.numeric(quantile(res[,1], probs=c(.025,.975), na.rm=T)), + equals(c(1,6))) expect_that(as.numeric(quantile(res2[1,], probs=c(.001,.975), na.rm=T)), equals(c(1,6))) #SECOND RANGE - expect_that(as.numeric(quantile(res[2,], probs=c(.025), na.rm=T)), - equals(0.06)) + #max would be 6, should occur less than 1% of the time + #min should be 0, should occur 2.5% of the time + expect_that(as.numeric(quantile(res[,2], probs=c(.025), na.rm=T)), + equals(0)) expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) - expect_true(as.numeric(quantile(res[2,], probs=c(.99), na.rm=T))<6) + expect_true(as.numeric(quantile(res[,2], probs=c(.99), na.rm=T))<6) expect_true(as.numeric(quantile(res2[2,], probs=c(.99), na.rm=T))<6) #THIRD RANGE - expect_that(as.numeric(quantile(res[3,], probs=c(.025,.975), na.rm=T)), - equals(c(0.1,2.0))) + #Should be determinsitically 0 or NaN + expect_that(as.numeric(quantile(res[,3], probs=c(.025,.975), na.rm=T)), + equals(c(0,0))) expect_that(as.numeric(quantile(res2[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) @@ -138,9 +143,9 @@ test_that("performs correctly for test case 2 (points on a line) - independent c res2 <- get.tau.typed.bootstrap(x, 1, 2, c(1.5,2.5,3.5), c(0,1.5,2.5), 1500, comparison.type="independent")[,-(1:2)] - expect_that(median(as.numeric(res[1,]), na.rm=T), equals(1.5)) - expect_that(median(as.numeric(res[2,]), na.rm=T), equals(Inf)) - expect_that(median(as.numeric(res[3,]), na.rm=T), equals(Inf)) + expect_that(median(as.numeric(res[,1]), na.rm=T), equals(Inf)) + expect_that(median(as.numeric(res[,2]), na.rm=T), equals(1)) + expect_that(median(as.numeric(res[,3]), na.rm=T), equals(0)) expect_that(median(as.numeric(res2[1,]), na.rm=T), equals(Inf)) expect_that(median(as.numeric(res2[2,]), na.rm=T), equals(1)) @@ -151,10 +156,10 @@ test_that("performs correctly for test case 2 (points on a line) - independent c # provide the interval required. #FIRST RANGE - #max would be Inf, occuring most of the time - #min would be 1, occuring just over .01% of the time - expect_that(as.numeric(quantile(res[1,], probs=c(.001,.975), na.rm=T)), - equals(c(0.003,Inf))) + #max would be Inf, occurring most of the time + #min would be 1, occurring just over .01% of the time + expect_that(as.numeric(quantile(res[,1], probs=c(.001,.975), na.rm=T)), + equals(c(1,Inf))) expect_that(as.numeric(quantile(res2[1,], probs=c(.001,.975), na.rm=T)), equals(c(1,Inf))) @@ -162,8 +167,8 @@ test_that("performs correctly for test case 2 (points on a line) - independent c #max would be Inf, should occur around 25% of the time. .7 should be # reliably less than #min should be 0, should occur 2.5% of the time - expect_that(as.numeric(quantile(res[2,], probs=c(.025), na.rm=T)), - equals(Inf)) + expect_that(as.numeric(quantile(res[,2], probs=c(.025), na.rm=T)), + equals(0)) expect_that(as.numeric(quantile(res2[2,], probs=c(.025), na.rm=T)), equals(0)) @@ -174,8 +179,8 @@ test_that("performs correctly for test case 2 (points on a line) - independent c #THIRD RANGE #Should be determinsitically 0 or NaN - expect_that(as.numeric(quantile(res[3,], probs=c(.025,.975), na.rm=T)), - equals(c(Inf,Inf))) + expect_that(as.numeric(quantile(res[,3], probs=c(.025,.975), na.rm=T)), + equals(c(0,0))) expect_that(as.numeric(quantile(res2[3,], probs=c(.025,.975), na.rm=T)), equals(c(0,0))) From 231750fecf682ed3f170fe4fa511845443d5490a Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 27 Mar 2020 11:45:52 +0000 Subject: [PATCH 66/70] update get_tau_ci and get_tau_bootstrap --- NEWS.md | 1 + R/examples/get_tau_bootstrap.R | 17 +++++++++-------- R/examples/get_tau_ci.R | 15 +++++++++------ R/spatialfuncs.r | 10 +++++----- 4 files changed, 24 insertions(+), 19 deletions(-) diff --git a/NEWS.md b/NEWS.md index aa11e33..f37fc14 100644 --- a/NEWS.md +++ b/NEWS.md @@ -43,4 +43,5 @@ Timothy M Pollington would like to thank the co-authors of the paper that inform # Next changes * The *Modified Marked Point Spatial Bootstrap* [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] has not yet been applied. In [[2](https://doi.org/10.5281/zenodo.2552850 "t-pollington/tau-statistic-speedup: First release of tau statistic speedup")] it was applied to the tau odds estimator however for consistency we have decided to delay its implementation so that we can apply it also to the tau prevalence estimator. So please note that `get.tau.bootstrap()` and `get.tau.D.param.est()` values are still likely to change. +* Enable `plot.tau()` to accept `tauCI` objects alone, without need for `tau()` object. * Changes to the un-typed tau functions also applied to the typed tau functions. \ No newline at end of file diff --git a/R/examples/get_tau_bootstrap.R b/R/examples/get_tau_bootstrap.R index d0eaab2..25529de 100644 --- a/R/examples/get_tau_bootstrap.R +++ b/R/examples/get_tau_bootstrap.R @@ -1,6 +1,6 @@ \donttest{ -#compare normally distributed with uniform points +# compare normally distributed with uniform points x<-cbind(1,runif(100,-100,100), runif(100,-100,100)) x<-rbind(x, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) colnames(x) <- c("type","x","y") @@ -15,14 +15,15 @@ r.max<-seq(10,100,10) r.min<-seq(0,90,10) r.mid <- (r.max+r.min)/2 -tau<-get.tau(x,fun,r=r.max,r.low=r.min) -tau.boot<-get.tau.bootstrap(x,fun,r=r.max,r.low=r.min,boot.iter=50) +tau<-get.tau(x,fun,r=r.max,r.low=r.min,"representative", data.frame = TRUE) +tau.ci = get.tau.ci(x, fun, r.max, r.min, 50, "representative", 0.95, data.frame = TRUE) -tau.ci<-apply(tau.boot[,-(1:2)],1,quantile,probs=c(0.25,0.75)) +## plot.tau() method +plot.tau(tau, r.mid = TRUE, ptwise.CI = tau.ci) -plot(r.mid, tau$tau ,ylim=c(min(tau.ci),max(tau.ci)), type="l", log="y") +## previous plot() method using connected lines to join the top and bottoms of the pointwise CIs. This may lead the user to perform graphical hypothesis testing using this plot without considering the specific distance band of interest before plotting. +plot(r.mid, tau$tau.pt.est ,ylim=c(min(tau.ci$ci.low),max(tau.ci$ci.high)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") -lines(r.mid, tau.ci[1,] , lty=2) -lines(r.mid, tau.ci[2,] , lty=2) - +lines(r.mid, tau.ci$ci.low, lty=2) +lines(r.mid, tau.ci$ci.high, lty=2) } \ No newline at end of file diff --git a/R/examples/get_tau_ci.R b/R/examples/get_tau_ci.R index 8400219..9c59145 100644 --- a/R/examples/get_tau_ci.R +++ b/R/examples/get_tau_ci.R @@ -15,12 +15,15 @@ r.max<-seq(10,100,10) r.min<-seq(0,90,10) r.mid <- (r.max+r.min)/2 -tau <- get.tau.ci(x,fun,r=r.max,r.low=r.min,boot.iter=50) +tau.CI <- get.tau.ci(x,fun,r=r.max,r.low=r.min,boot.iter=50, comparison.type = "representative") -plot(r.mid, tau$pt.est, ylim=c(1/max(tau[,3:5]), max(tau[,3:5])), type="l", log="y", - xlab="Distance", ylab="Tau") -lines(r.mid, tau$ci.low , lty=2) -lines(r.mid, tau$ci.high, lty=2) -lines(c(0,100),c(1,1), lty=3, col="grey") +## plot.tau() method +tau = get.tau(x,fun,r=r.max,r.low=r.min, comparison.type = "representative") +plot.tau(x = tau, ptwise.CI = tau.CI) +## previous plot() method +plot(r.mid, tau.CI$pt.est, ylim=c(min(tau.CI$pt.est,tau.CI$ci.low), max(tau.CI$pt.est,tau.CI$ci.high)), type="l", xlab="Distance", ylab="Tau") +lines(r.mid, tau.CI$ci.low , lty=2) +lines(r.mid, tau.CI$ci.high, lty=2) +lines(c(0,100),c(1,1), lty=3, col="grey") } \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 314a1e5..92d46c9 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1048,12 +1048,12 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ ##' \item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau} and \code{tauparamest} objects. ##' } ##' -##' @param x \code{tau} object. Required for all plots. +##' @param x \code{tau} object; create using \code{get.tau(..., data.frame = TRUE)}. Required for all plots. ##' @param r.mid If \code{TRUE}(default) then for each point the x-coordinate of the midpoint of a distance band is plotted and if \code{FALSE} the endpoint of the distance band is plotted. ##' @param tausim the set of spatially-bootstrapped simulations of \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. Required for Estimation of the clustering range plot. -##' @param ptwise.CI the set of pointwise CIs of \code{tauCI} class. Optional for the diagnostic plot but should not be supplied for the other plots. -##' @param GET.res is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. -##' @param d.param.est a required object for Estimating the clustering range plot but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary. +##' @param ptwise.CI the set of pointwise CIs of \code{tauCI} class; create using \code{get.tau(..., data.frame = TRUE)}. Optional for the diagnostic plot but should not be supplied for the other plots. +##' @param GET.res is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET(..., data.frame = TRUE)}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. +##' @param d.param.est a required object for Estimating the clustering range plot from \code{get.tau.D.param(..., data.frame = TRUE)}, but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary. ##' @author Timothy M Pollington ##' ##' @family get.tau @@ -1125,7 +1125,7 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = } if(!is.null(ptwise.CI)){ ylimrange = range(c(x$tau.pt.est,ptwise.CI$ci.low,ptwise.CI$ci.high), na.rm = TRUE) - plot(x = r.end, y = x$tau.pt.est, xlim=xlim, + plot(x = r.end, y = x$tau.pt.est, xlim=xlim, ylim=ylimrange+diff(ylimrange)*c(-0.05,0.05), cex.axis=1,col="black", xlab=xlab, ylab="Tau", cex.main=1, lwd=2, type="p", las=1, cex.axis=1, xaxs = "i", yaxs = "i", pch = 16) From 27828217678d041226495da34f9c1f7431d23119 Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 27 Mar 2020 15:07:25 +0000 Subject: [PATCH 67/70] GET_tau_GET done --- R/examples/get_tau_GET.R | 27 +++++++++++++++++++++++++++ R/examples/get_tau_permute.R | 2 +- R/spatialfuncs.r | 27 ++++++++++++++------------- 3 files changed, 42 insertions(+), 14 deletions(-) create mode 100644 R/examples/get_tau_GET.R diff --git a/R/examples/get_tau_GET.R b/R/examples/get_tau_GET.R new file mode 100644 index 0000000..d7cb291 --- /dev/null +++ b/R/examples/get_tau_GET.R @@ -0,0 +1,27 @@ +\donttest{ +# Load data +r.max<-seq(20,1000,20) +r.min<-seq(0,980,20) +r.mid<-(r.max+r.min)/2 +sero.type.func<-function(a,b,tlimit=20){ + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) +} + +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) + +# perform graphical hypothesis test using a global envelope test +Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, permutations = 50, "representative") + +#plot point estimate with global envelope and simulation of the null distribution +plot.tau(x = Dengue.tau, r.mid = TRUE, GET.res = Dengue.GET) +} \ No newline at end of file diff --git a/R/examples/get_tau_permute.R b/R/examples/get_tau_permute.R index a1bfa42..5cdb969 100644 --- a/R/examples/get_tau_permute.R +++ b/R/examples/get_tau_permute.R @@ -20,9 +20,9 @@ tau.null<-get.tau.permute(x,fun,r=r.max,r.low=r.min,permutations=50,comparison.t null.ci<-apply(tau.null[,-(1:2)],1,quantile,probs=c(0.25,0.75)) +# note these plots are only for illustrative purposes to show how get.tau.permute() can generate the null distribution. These should not be used for graphical hypothesis testing nor parameter estimation of the clustering endpoint. plot(r.mid, tau$tau, ylim=c(1/max(tau$tau),max(tau$tau)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") lines(r.mid, null.ci[1,] , lty=2) lines(r.mid, null.ci[2,] , lty=2) - } \ No newline at end of file diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 92d46c9..15eae25 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -957,6 +957,7 @@ get.tau <- function(posmat, ##' ##' @family get.tau ##' @family spatialtau +##' @example R/examples/get_tau_GET.R ##' get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.type){ @@ -966,7 +967,7 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t GET.res = GET::global_envelope_test(curve_sets = curveset, type = "rank", alpha = 0.05, alternative = c("two.sided"), ties = "erl", probs = c(0.025, 0.975), quantile.type = 7, central = "median") - GET.res$tau.permute = tau.permute + GET.res = list(GET.res, tau.permute) class(GET.res) <- "tauGET" return(GET.res) } @@ -1113,7 +1114,6 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = } if(is.null(GET.res) | is.null(d.param.est)){ - if(is.null(ptwise.CI)){ plot(x = r.end, y = x$tau.pt.est, xlim=xlim, ylim=range(x$tau.pt.est, na.rm = TRUE)+diff(range(x$tau.pt.est, na.rm = TRUE))*c(-0.05,0.05), @@ -1137,24 +1137,25 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = } if(!is.null(GET.res)){ - plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", + permutations = dim(GET.res[[2]])[1] + plot(NULL, xlim = c(0,max(x$r, na.rm = TRUE)), ylim = c(min(GET.res[[1]]$lo, GET.res[[1]]$obs, na.rm = TRUE),max(GET.res[[1]]$hi, GET.res[[1]]$obs, na.rm = TRUE)), xaxt = "n", yaxt = "n", xaxs = "i", yaxs = "i", ylab = "Tau", xlab = xlab, lwd = 4, cex.lab = 1.5) for (i in 1:permutations) { - lines(x$r, GET.res$tau.permute[,i], col = scales::alpha("grey", alpha = 0.3), lwd = 1) + lines(x$r, GET.res[[2]][i,], col = scales::alpha("grey", alpha = 0.3), lwd = 1) } - yaxis.range = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE)) + yaxis.range = c(min(GET.res[[1]]$lo, GET.res[[1]]$obs, na.rm = TRUE),max(GET.res[[1]]$hi, GET.res[[1]]$obs, na.rm = TRUE)) yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) yaxis.lab = sort(yaxis.lab) yaxis.lab = round(yaxis.lab,digits = 1) yaxis.lab = unique(yaxis.lab) # prevents more than one 1.0 value yaxis.lab[which(yaxis.lab==1)] = round(yaxis.lab[which(yaxis.lab==1)],digits = 0) axis(2, las=1, at=yaxis.lab, labels = as.character(yaxis.lab), lwd = 1) - lines(GET.res$r, GET.res$lo, col = "slategrey", lwd = 3) - lines(GET.res$r, GET.res$hi, col = "slategrey", lwd = 3) - lines(GET.res$r, GET.res$central, col = "red", lwd = 3) - lines(GET.res$r, GET.res$obs, lwd = 4) + lines(GET.res[[1]]$r, GET.res[[1]]$lo, col = "slategrey", lwd = 3) + lines(GET.res[[1]]$r, GET.res[[1]]$hi, col = "slategrey", lwd = 3) + lines(GET.res[[1]]$r, GET.res[[1]]$central, col = "red", lwd = 3) + lines(GET.res[[1]]$r, GET.res[[1]]$obs, lwd = 3) axis(1, lwd = 1) - abline(h=1, lty = 2, lwd = 4) + abline(h=1, lty = 2, lwd = 3) legend("topright", legend=c(as.expression(bquote(~ hat(tau) ~ "point estimate")), "95% global envelope",as.expression(bquote("simulations of " ~ H[0])), "median simulation", @@ -1162,10 +1163,10 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = col=c("black", "slategrey", "grey", "red", "black"), lty=c(1,1,1,1,2), cex=1.05, yjust = 0.5, lwd = 6) par(xpd = TRUE) - pint.lo = round(attr(GET.res,"p_interval"), digits = 3)[1] - pint.hi = round(attr(GET.res,"p_interval"), digits = 3)[2] + pint.lo = round(attr(GET.res[[1]],"p_interval"), digits = 3)[1] + pint.hi = round(attr(GET.res[[1]],"p_interval"), digits = 3)[2] pint.x = 0.5 * max(x$r, na.rm = TRUE) - pint.y = c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res$lo, GET.res$obs, na.rm = TRUE),max(GET.res$hi, GET.res$obs, na.rm = TRUE))) + pint.y = c(min(GET.res[[1]]$lo, GET.res[[1]]$obs, na.rm = TRUE),max(GET.res[[1]]$hi, GET.res[[1]]$obs, na.rm = TRUE))[1] + 0.5*diff(c(min(GET.res[[1]]$lo, GET.res[[1]]$obs, na.rm = TRUE),max(GET.res[[1]]$hi, GET.res[[1]]$obs, na.rm = TRUE))) text(bquote("p-value in [" ~ .(pint.lo) * "," * .(pint.hi) * "]"), x = pint.x, y = pint.y) } From cbc9922f77e6c9d46d856d3a5dec33ba4ad0357f Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Fri, 27 Mar 2020 18:52:54 +0000 Subject: [PATCH 68/70] Fix warnings and bugs after running Check. --- NAMESPACE | 2 +- NEWS.md | 1 + R/examples/get_tau.R | 18 +++++--- R/examples/get_tau_D_param_est.R | 38 +++++++++++++++++ R/examples/get_tau_GET.R | 6 ++- R/examples/get_tau_bootstrap.R | 4 +- R/examples/get_tau_ci.R | 4 +- R/examples/get_tau_permute.R | 4 +- R/spatialfuncs.r | 58 ++++++++++++------------- inst/CITATION | 1 - man/get.pi.Rd | 8 ++-- man/get.pi.bootstrap.Rd | 2 +- man/{applyBCa.Rd => get.pi.ci.Rd} | 18 +++++--- man/get.pi.permute.Rd | 2 +- man/get.pi.typed.Rd | 2 +- man/get.pi.typed.bootstrap.Rd | 2 +- man/get.pi.typed.permute.Rd | 2 +- man/get.tau.D.param.est.Rd | 46 ++++++++++++++++++-- man/get.tau.GET.Rd | 33 +++++++++++++- man/get.tau.Rd | 71 +++++++++++++++++-------------- man/get.tau.bootstrap.Rd | 19 +++++---- man/get.tau.ci.Rd | 23 +++++----- man/get.tau.permute.Rd | 4 +- man/get.theta.ci.Rd | 9 ++-- man/plot.tau.Rd | 12 +++--- 25 files changed, 265 insertions(+), 124 deletions(-) create mode 100644 R/examples/get_tau_D_param_est.R rename man/{applyBCa.Rd => get.pi.ci.Rd} (94%) diff --git a/NAMESPACE b/NAMESPACE index 490dbd0..adae25b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,7 +38,7 @@ export(get.tau.typed) export(get.tau.ci) export(get.tau.typed.bootstrap) export(get.tau.typed.permute) -export(plot.tau) +S3method(plot, tau) export(sim.epidemic) export(sim.plot) export(est.wt.matrix) diff --git a/NEWS.md b/NEWS.md index f37fc14..b84ab4a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -43,5 +43,6 @@ Timothy M Pollington would like to thank the co-authors of the paper that inform # Next changes * The *Modified Marked Point Spatial Bootstrap* [[1](https://doi.org/10.1016/j.spasta.2020.100438 "Developments in statistical inference when assessing spatiotemporal disease clustering with the tau statistic")] has not yet been applied. In [[2](https://doi.org/10.5281/zenodo.2552850 "t-pollington/tau-statistic-speedup: First release of tau statistic speedup")] it was applied to the tau odds estimator however for consistency we have decided to delay its implementation so that we can apply it also to the tau prevalence estimator. So please note that `get.tau.bootstrap()` and `get.tau.D.param.est()` values are still likely to change. +* `tau.GET()` examples increased to 2,500 permutations once speedups introduced. * Enable `plot.tau()` to accept `tauCI` objects alone, without need for `tau()` object. * Changes to the un-typed tau functions also applied to the typed tau functions. \ No newline at end of file diff --git a/R/examples/get_tau.R b/R/examples/get_tau.R index 321539a..bed0e91 100644 --- a/R/examples/get_tau.R +++ b/R/examples/get_tau.R @@ -16,8 +16,10 @@ geno.type.func<-function(a,b,tlimit=20){ ## R0 of 1 data(DengueSimulationR01) -sero.tau.R01 <- get.tau(DengueSimR01, sero.type.func, r=r.max, r.low=r.min, comparison.type="independent") -geno.tau.R01 <- get.tau(DengueSimR01, geno.type.func, r=r.max, r.low=r.min, comparison.type="independent") +sero.tau.R01 <- get.tau(DengueSimR01, sero.type.func, r=r.max, r.low=r.min, + comparison.type="independent") +geno.tau.R01 <- get.tau(DengueSimR01, geno.type.func, r=r.max, r.low=r.min, + comparison.type="independent") plot(r.mid,sero.tau.R01$tau,ylim=c(0.3,max(geno.tau.R01$tau)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), @@ -37,8 +39,10 @@ legend("topright", ## R0 of 2 data(DengueSimulationR02) -sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, comparison.type="independent") -geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, comparison.type="independent") +sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, + comparison.type="independent") +geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, + comparison.type="independent") plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02$tau.pt.est)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), @@ -61,10 +65,12 @@ sero.type.rep.func<-function(a,b,tlimit=20){ } # get point estimate -Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, + "representative", data.frame = TRUE) # get 95% BCa CI -CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 25, "representative", ci.level = 0.95, data.frame = TRUE) +CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 25, + "representative", ci.level = 0.95, data.frame = TRUE) #plot point estimate with CI plot.tau(x = Dengue.tau, r.mid = TRUE, ptwise.CI = CIs) diff --git a/R/examples/get_tau_D_param_est.R b/R/examples/get_tau_D_param_est.R new file mode 100644 index 0000000..504958d --- /dev/null +++ b/R/examples/get_tau_D_param_est.R @@ -0,0 +1,38 @@ +\donttest{ +# Load data +r.max<-seq(20,1000,20) +r.min<-seq(0,980,20) +r.mid<-(r.max+r.min)/2 +sero.type.func<-function(a,b,tlimit=20){ + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) +} + +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", + data.frame = TRUE) + +# perform graphical hypothesis test using a global envelope test +Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, + permutations = 50, "representative") + +# plot point estimate with global envelope and simulation of the null distribution +plot.tau(x = Dengue.tau, r.mid = TRUE, GET.res = Dengue.GET) + +# if the graphical hypothesis test and p-value interval suggests evidence against H_0, +# and the graph suggests clustering, the range of this can be estimated +tausim = get.tau.bootstrap(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 100, + "representative", data.frame = FALSE) +Dengue.dparam = get.tau.D.param.est(r = r.max, tausim = tausim, Dengue.GET) +median(Dengue.dparam$envelope) # median estimate for the clustering endpoint +Dengue.dparam$envelope # 95% BCa CI +plot.tau(Dengue.tau, tausim = tausim, d.param.est = Dengue.dparam) +} \ No newline at end of file diff --git a/R/examples/get_tau_GET.R b/R/examples/get_tau_GET.R index d7cb291..5384683 100644 --- a/R/examples/get_tau_GET.R +++ b/R/examples/get_tau_GET.R @@ -17,10 +17,12 @@ sero.type.rep.func<-function(a,b,tlimit=20){ } # get point estimate -Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", data.frame = TRUE) +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", + data.frame = TRUE) # perform graphical hypothesis test using a global envelope test -Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, permutations = 50, "representative") +Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, + permutations = 50, "representative") #plot point estimate with global envelope and simulation of the null distribution plot.tau(x = Dengue.tau, r.mid = TRUE, GET.res = Dengue.GET) diff --git a/R/examples/get_tau_bootstrap.R b/R/examples/get_tau_bootstrap.R index 25529de..631a295 100644 --- a/R/examples/get_tau_bootstrap.R +++ b/R/examples/get_tau_bootstrap.R @@ -21,7 +21,9 @@ tau.ci = get.tau.ci(x, fun, r.max, r.min, 50, "representative", 0.95, data.frame ## plot.tau() method plot.tau(tau, r.mid = TRUE, ptwise.CI = tau.ci) -## previous plot() method using connected lines to join the top and bottoms of the pointwise CIs. This may lead the user to perform graphical hypothesis testing using this plot without considering the specific distance band of interest before plotting. +## previous plot() method using connected lines to join the top and bottoms of the pointwise CIs. +#This may lead the user to perform graphical hypothesis testing using this plot without considering +#the specific distance band of interest before plotting. plot(r.mid, tau$tau.pt.est ,ylim=c(min(tau.ci$ci.low),max(tau.ci$ci.high)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") lines(r.mid, tau.ci$ci.low, lty=2) diff --git a/R/examples/get_tau_ci.R b/R/examples/get_tau_ci.R index 9c59145..846ab52 100644 --- a/R/examples/get_tau_ci.R +++ b/R/examples/get_tau_ci.R @@ -22,7 +22,9 @@ tau = get.tau(x,fun,r=r.max,r.low=r.min, comparison.type = "representative") plot.tau(x = tau, ptwise.CI = tau.CI) ## previous plot() method -plot(r.mid, tau.CI$pt.est, ylim=c(min(tau.CI$pt.est,tau.CI$ci.low), max(tau.CI$pt.est,tau.CI$ci.high)), type="l", xlab="Distance", ylab="Tau") +plot(r.mid, tau.CI$pt.est, ylim=c(min(tau.CI$pt.est,tau.CI$ci.low), + max(tau.CI$pt.est,tau.CI$ci.high)), type="l", xlab="Distance", + ylab="Tau") lines(r.mid, tau.CI$ci.low , lty=2) lines(r.mid, tau.CI$ci.high, lty=2) lines(c(0,100),c(1,1), lty=3, col="grey") diff --git a/R/examples/get_tau_permute.R b/R/examples/get_tau_permute.R index 5cdb969..b2d1ccc 100644 --- a/R/examples/get_tau_permute.R +++ b/R/examples/get_tau_permute.R @@ -20,7 +20,9 @@ tau.null<-get.tau.permute(x,fun,r=r.max,r.low=r.min,permutations=50,comparison.t null.ci<-apply(tau.null[,-(1:2)],1,quantile,probs=c(0.25,0.75)) -# note these plots are only for illustrative purposes to show how get.tau.permute() can generate the null distribution. These should not be used for graphical hypothesis testing nor parameter estimation of the clustering endpoint. +# note these plots are only for illustrative purposes to show how get.tau.permute() can generate +# the null distribution. These should not be used for graphical hypothesis testing nor parameter +# estimation of the clustering endpoint. plot(r.mid, tau$tau, ylim=c(1/max(tau$tau),max(tau$tau)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") lines(r.mid, null.ci[1,] , lty=2) diff --git a/R/spatialfuncs.r b/R/spatialfuncs.r index 15eae25..25b86b5 100644 --- a/R/spatialfuncs.r +++ b/R/spatialfuncs.r @@ -1,7 +1,14 @@ +applyBCa <- function(boots, ci.level){ + boots = boots[!is.na(boots)] + CI = coxed::bca(boots, conf.level = ci.level) + return(CI) +} + ##' Generalized version of \code{get.pi} ##' ##' Generalized version of the \code{get.pi} function that takes in an arbitrary function and -##' returns the probability that a point within a particular range of a point of interest shares the relationship +##' returns the probability that a point within a particular range of a point of interest shares +##' the relationship ##' specified by the passed in function with that point. ##' ##' @param posmat a matrix with columns x, y and any other named @@ -11,7 +18,8 @@ ##' \item for pairs included in the numerator and denominator ##' \item for pairs that should only be included in the denominator ##' \item for pairs that should be ignored all together} -##' Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of the matrix should be +##' Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of +##' the matrix should be ##' referenced numerically ##' so this is not available to the \code{fun} ##' @param r the series of spatial distances (or their maximums) we are @@ -260,12 +268,6 @@ get.theta.typed <- function(posmat, ##' @example R/examples/get_pi_ci.R ##' @md -applyBCa <- function(boots, ci.level){ - boots = boots[!is.na(boots)] - CI = coxed::bca(boots, conf.level = ci.level) - return(CI) -} - get.pi.ci <- function(posmat, fun, r = 1, @@ -296,25 +298,18 @@ get.pi.ci <- function(posmat, ##' Wrapper to \code{get.theta.bootstrap} that takes care of calculating the ##' confidence intervals based on the bootstrapped values. ##' -##' ##' @param posmat a matrix with columns type, x and y ##' @param fun the function to decide relationships ##' @param r the series of spatial distances we are interested in ##' @param r.low the low end of each range. 0 by default ##' @param boot.iter the number of bootstrap iterations -##' @param ci.low the low end of the ci...0.025 by default -##' @param ci.high the high end of the ci...0.975 by default +##' @param ci.level significance level of the 95% BCa CI, default = 0.95 ##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) ##' -##' @return a matrix with a row for the high and low values and -##' a column per distance -##' +##' @return a matrix with a row for the high and low values and a column per distance ##' @author Justin Lessler -##' ##' @family get.theta -##' ##' @example R/examples/get_theta_ci.R -##' get.theta.ci <- function(posmat, fun, @@ -934,7 +929,7 @@ get.tau <- function(posmat, ##' @param r the series of spatial distances (or their maximums) we are ##' interested in ##' @param r.low the low end of each range, 0 by default -##' @param permutations number of simulations of H_0 +##' @param permutations number of simulations of H_0. 2,500 is an optimal number according to Myllymäki et al. (2017). ##' @param comparison.type what type of points are included in the comparison set. ##' \itemize{ ##' \item "representative" if comparison set is representative of the underlying population @@ -978,8 +973,7 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t ##' ##' @param r the series of spatial distances (or their maximums) we are ##' interested in -##' @param boot.iter number of spatial bootstraps -##' @param tausim the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. +##' @param tausim the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap(..., data.frame = FALSE)} to obtain this. ##' @param GETres is a required object and is obtained from a previous global hypothesis test using \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. ##' @return An object of class \code{tauparamest} which can then be plotted using \code{plot.tau()}. The object consists of: ##' \itemize{ @@ -993,9 +987,9 @@ get.tau.GET <- function(posmat, fun, r, r.low, permutations = 2500, comparison.t ##' ##' @family get.tau ##' @family spatialtau -##' +##' @example R/examples/get_tau_D_param_est.R -get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ +get.tau.D.param.est <- function(r, tausim, GETres = NULL){ stopifnot(!is.null(GETres)) # makes sure the user has been principled and performed a global # hypothesis test using get.tau() before estimating D stopifnot(length(r)>1) @@ -1003,6 +997,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ if(!is.null(names(tausim))){ # ie if tausim is like a 'data.frame despite having a taubstrap class tausim = t(tausim[,-c(1,2)]) } + boot.iter = dim(tausim)[1] ciIntercept <- function(boot.iter, r, tausim) { j.max = length(r) # define d.envelope by finding for each bootstrap sample the (interpolated) d-intercept point @@ -1025,8 +1020,8 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ } } } - print(paste0("% of boostrap sims crossing tau = 1 from above is ",length(d.envelope)/boot.iter*100,"%")) - print(paste0("% of bootstrap sims always above tau = 1 is ",alwaysabove1/boot.iter*100,"%")) + print(paste0(length(d.envelope)/boot.iter*100, "% of boostrap sims crossing tau = 1 from above")) + print(paste0(alwaysabove1/boot.iter*100, "% of bootstrap sims always above tau = 1")) if(alwaysabove1>0){ warning("Note that there are some bootstrap sims that stay above tau = 1 for the entire distance band set. If more than a few percent of these are above tau = 1 then a reliable CI cannot be constructed as it will have not have come from a random sample.") } @@ -1046,7 +1041,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ ##' \enumerate{ ##' \item Diagnostic plot to indicate the structure or magnitude of spatiotemporal clustering. Requires \code{tau} object; \code{tauCI} object optional to draw pointwise CIs. This plot is only suitable for the purpose of a graphical hypothesis test in the situation that a specific distance band is selected prior to graph creation. ##' \item Graphical hypothesis test to assess the evidence against the null hypothesis (no spatiotemporal clustering nor inhibition). Requires \code{tau} and \code{tauGET} objects. -##' \item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau} and \code{tauparamest} objects. +##' \item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau}, \code{tauparamest} and \code{taubstrap} objects. ##' } ##' ##' @param x \code{tau} object; create using \code{get.tau(..., data.frame = TRUE)}. Required for all plots. @@ -1055,6 +1050,7 @@ get.tau.D.param.est <- function(r, boot.iter, tausim, GETres = NULL, ...){ ##' @param ptwise.CI the set of pointwise CIs of \code{tauCI} class; create using \code{get.tau(..., data.frame = TRUE)}. Optional for the diagnostic plot but should not be supplied for the other plots. ##' @param GET.res is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET(..., data.frame = TRUE)}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range. ##' @param d.param.est a required object for Estimating the clustering range plot from \code{get.tau.D.param(..., data.frame = TRUE)}, but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary. +##' @param ... other arguments which are standard for \code{plot()} for plot customisation ##' @author Timothy M Pollington ##' ##' @family get.tau @@ -1085,6 +1081,9 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = if(!is.null(GET.res) & !is.null(d.param.est)){ stop("To avoid misinterpretation of visual results we do not allow global envelopes and clustering range estimates to be plotted on the same graph") } + if(is.null(tausim) & !is.null(d.param.est)){ + stop("Need tausim and d.param.est class objects to plot clustering range estimates") + } if(r.mid==TRUE){ r.end = 0.5*(x$r.low + x$r) midorend = "at distance band midpoint" @@ -1171,7 +1170,6 @@ plot.tau <- function(x, r.mid = TRUE, tausim = NULL, ptwise.CI = NULL, GET.res = } if(!is.null(d.param.est) & !is.null(tausim)){ - xlim = c(0,min(2*median(d.param.est$envelope),max(x$r))) yaxis.range = c(min(x$tau.pt.est, tausim, na.rm = TRUE),max(x$tau.pt.est, tausim, na.rm = TRUE)) yaxis.lab = c(seq(yaxis.range[1],yaxis.range[2],length.out = 5),1) @@ -1280,8 +1278,7 @@ get.tau.typed <- function(posmat, ##' @param r.low the low end of each range....0 by default ##' @param boot.iter the number of bootstrap iterations ##' @param comparison.type the comparison type to pass to get.tau -##' @param ci.low the low end of the ci...0.025 by default -##' @param ci.high the high end of the ci...0.975 by default +##' @param ci.level significance level of the BCa CI, default = 0.95 ##' @param data.frame logical indicating whether to return results as a data frame (default = TRUE) ##' ##' @return a data frame with the point estimate of tau and its low and high confidence interval at each distance @@ -1302,8 +1299,9 @@ get.tau.ci <- function(posmat, ci.level = 0.95, data.frame=TRUE) { - boots <- get.tau.bootstrap(posmat, fun, r, r.low, boot.iter, comparison.type, data.frame = FALSE) - rc <- apply(boots, 2, applyBCa, ci.level = 0.95) + boots <- get.tau.bootstrap(posmat, fun, r, r.low, boot.iter, comparison.type, + data.frame = FALSE) + rc <- apply(boots, 2, applyBCa, ci.level) if (data.frame == FALSE) { class(rc) <- "tauCI" diff --git a/inst/CITATION b/inst/CITATION index fdc1c64..be94c03 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -57,5 +57,4 @@ bibentry( journal = "Spatial Statistics", url = "https://doi.org/10.1016/j.spasta.2020.100438", doi = "10.1016/j.spasta.2020.100438" - note = "Pre-proof" ) \ No newline at end of file diff --git a/man/get.pi.Rd b/man/get.pi.Rd index a47d822..5d404bd 100644 --- a/man/get.pi.Rd +++ b/man/get.pi.Rd @@ -15,7 +15,8 @@ columns needed by \code{fun}} \item for pairs included in the numerator and denominator \item for pairs that should only be included in the denominator \item for pairs that should be ignored all together} -Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of the matrix should be +Note that names from \code{posmat} are not preserved in calls to \code{fun}, so the columns of +the matrix should be referenced numerically so this is not available to the \code{fun}} @@ -33,7 +34,8 @@ pi value for each distance range that we look at. Where: } \description{ Generalized version of the \code{get.pi} function that takes in an arbitrary function and -returns the probability that a point within a particular range of a point of interest shares the relationship +returns the probability that a point within a particular range of a point of interest shares +the relationship specified by the passed in function with that point. } \examples{ @@ -56,8 +58,8 @@ sero.pi<-get.pi(DengueSimR02,sero.type.func,r=r.max,r.low=r.min) } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, diff --git a/man/get.pi.bootstrap.Rd b/man/get.pi.bootstrap.Rd index 86ff1f2..fdcbbe6 100644 --- a/man/get.pi.bootstrap.Rd +++ b/man/get.pi.bootstrap.Rd @@ -73,7 +73,7 @@ lines(r.mid, pi.ci[2,] , lty=2) } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, diff --git a/man/applyBCa.Rd b/man/get.pi.ci.Rd similarity index 94% rename from man/applyBCa.Rd rename to man/get.pi.ci.Rd index c4626ef..dc8cfa2 100644 --- a/man/applyBCa.Rd +++ b/man/get.pi.ci.Rd @@ -1,14 +1,20 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/spatialfuncs.r -\name{applyBCa} -\alias{applyBCa} +\name{get.pi.ci} +\alias{get.pi.ci} \title{Calculate bootstrapped BCa confidence intervals from \code{get.pi} values.} \usage{ -applyBCa(boots, ci.level) +get.pi.ci( + posmat, + fun, + r = 1, + r.low = rep(0, length(r)), + boot.iter = 1000, + ci.level = 0.95, + data.frame = TRUE +) } \arguments{ -\item{ci.level}{the level of the desired BCa CI (default = 0.95)} - \item{posmat}{a matrix with named columns x and y for 2D individual location} \item{fun}{the function to decide transmission-related pairs} @@ -19,6 +25,8 @@ applyBCa(boots, ci.level) \item{boot.iter}{the number of bootstrap iterations (default = 1000)} +\item{ci.level}{the level of the desired BCa CI (default = 0.95)} + \item{data.frame}{logical: indicating whether to return results as a data frame (default = TRUE)} } \value{ diff --git a/man/get.pi.permute.Rd b/man/get.pi.permute.Rd index feb3ada..4006c10 100644 --- a/man/get.pi.permute.Rd +++ b/man/get.pi.permute.Rd @@ -65,8 +65,8 @@ lines(r.mid, null.ci[2,] , lty=2) } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.pi.typed.Rd b/man/get.pi.typed.Rd index d8ebc05..cca1a53 100644 --- a/man/get.pi.typed.Rd +++ b/man/get.pi.typed.Rd @@ -52,8 +52,8 @@ typed.pi<-get.pi.typed(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min) } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed.permute}()}, diff --git a/man/get.pi.typed.bootstrap.Rd b/man/get.pi.typed.bootstrap.Rd index b2f2be1..f6a15ef 100644 --- a/man/get.pi.typed.bootstrap.Rd +++ b/man/get.pi.typed.bootstrap.Rd @@ -54,8 +54,8 @@ typed.pi.bs<-get.pi.typed.bootstrap(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min,boot } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.permute}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.pi.typed.permute.Rd b/man/get.pi.typed.permute.Rd index f3f5a6d..4117f02 100644 --- a/man/get.pi.typed.permute.Rd +++ b/man/get.pi.typed.permute.Rd @@ -56,8 +56,8 @@ typed.pi.type.null<-get.pi.typed.permute(tmp,typeA=1,typeB=2,r=r.max,r.low=r.min } \seealso{ Other get.pi: -\code{\link{applyBCa}()}, \code{\link{get.pi.bootstrap}()}, +\code{\link{get.pi.ci}()}, \code{\link{get.pi.permute}()}, \code{\link{get.pi.typed.bootstrap}()}, \code{\link{get.pi.typed}()}, diff --git a/man/get.tau.D.param.est.Rd b/man/get.tau.D.param.est.Rd index 825414f..43b3555 100644 --- a/man/get.tau.D.param.est.Rd +++ b/man/get.tau.D.param.est.Rd @@ -4,15 +4,13 @@ \alias{get.tau.D.param.est} \title{Cluster range estimation using \code{get.tau.D.param.est}} \usage{ -get.tau.D.param.est(r, boot.iter, tausim, GETres = NULL, ...) +get.tau.D.param.est(r, tausim, GETres = NULL) } \arguments{ \item{r}{the series of spatial distances (or their maximums) we are interested in} -\item{boot.iter}{number of spatial bootstraps} - -\item{tausim}{the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this.} +\item{tausim}{the set of spatially-bootstrapped simulations. Has to be \code{taubstrap} class; use \code{get.tau.bootstrap(..., data.frame = FALSE)} to obtain this.} \item{GETres}{is a required object and is obtained from a previous global hypothesis test using \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range.} } @@ -32,6 +30,46 @@ Estimates the range of spatiotemporal clustering. It records the place on the ho } } +\examples{ +\donttest{ +# Load data +r.max<-seq(20,1000,20) +r.min<-seq(0,980,20) +r.mid<-(r.max+r.min)/2 +sero.type.func<-function(a,b,tlimit=20){ + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) +} + +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", + data.frame = TRUE) + +# perform graphical hypothesis test using a global envelope test +Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, + permutations = 50, "representative") + +# plot point estimate with global envelope and simulation of the null distribution +plot.tau(x = Dengue.tau, r.mid = TRUE, GET.res = Dengue.GET) + +# if the graphical hypothesis test and p-value interval suggests evidence against H_0, +# and the graph suggests clustering, the range of this can be estimated +tausim = get.tau.bootstrap(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 100, + "representative", data.frame = FALSE) +Dengue.dparam = get.tau.D.param.est(r = r.max, tausim = tausim, Dengue.GET) +median(Dengue.dparam$envelope) # median estimate for the clustering endpoint +Dengue.dparam$envelope # 95\% BCa CI +plot.tau(Dengue.tau, tausim = tausim, d.param.est = Dengue.dparam) +} +} \seealso{ Other get.tau: \code{\link{get.tau.GET}()}, diff --git a/man/get.tau.GET.Rd b/man/get.tau.GET.Rd index a50f182..e63f469 100644 --- a/man/get.tau.GET.Rd +++ b/man/get.tau.GET.Rd @@ -24,7 +24,7 @@ interested in} \item{r.low}{the low end of each range, 0 by default} -\item{permutations}{number of simulations of H_0} +\item{permutations}{number of simulations of H_0. 2,500 is an optimal number according to Myllymäki et al. (2017).} \item{comparison.type}{what type of points are included in the comparison set. \itemize{ @@ -53,6 +53,37 @@ Performs a graphical hypothesis test to assess the evidence against the null hyp } } +\examples{ +\donttest{ +# Load data +r.max<-seq(20,1000,20) +r.min<-seq(0,980,20) +r.mid<-(r.max+r.min)/2 +sero.type.func<-function(a,b,tlimit=20){ + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) +} + +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, "representative", + data.frame = TRUE) + +# perform graphical hypothesis test using a global envelope test +Dengue.GET = get.tau.GET(DengueSimRepresentative, sero.type.rep.func, r.max,r.min, + permutations = 50, "representative") + +#plot point estimate with global envelope and simulation of the null distribution +plot.tau(x = Dengue.tau, r.mid = TRUE, GET.res = Dengue.GET) +} +} \seealso{ Other get.tau: \code{\link{get.tau.D.param.est}()}, diff --git a/man/get.tau.Rd b/man/get.tau.Rd index f50c03c..25d1ca5 100644 --- a/man/get.tau.Rd +++ b/man/get.tau.Rd @@ -55,47 +55,28 @@ the probability (or odds) any point shares that relationship with that point. } \examples{ \donttest{ - -data(DengueSimulationR01) -data(DengueSimulationR02) -data(DengueSimRepresentative) - +# Load for all r.max<-seq(20,1000,20) r.min<-seq(0,980,20) r.mid<-(r.max+r.min)/2 - sero.type.func<-function(a,b,tlimit=20){ - if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{rc=2} - return(rc) + if(a[5]==b[5]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) } - geno.type.func<-function(a,b,tlimit=20){ - if(a[4]==b[4]&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{rc=2} - return(rc) -} - -sero.type.rep.func<-function(a,b,tlimit=20){ - if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} - else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} - return(rc) + if(a[4]==b[4]&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{rc=2} + return(rc) } +## R0 of 1 +data(DengueSimulationR01) sero.tau.R01 <- get.tau(DengueSimR01, sero.type.func, r=r.max, r.low=r.min, - comparison.type="independent") + comparison.type="independent") geno.tau.R01 <- get.tau(DengueSimR01, geno.type.func, r=r.max, r.low=r.min, - comparison.type="independent") - -sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, - comparison.type="independent") -geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, - comparison.type="independent") - -sero.tau.representative <- get.tau(DengueSimRepresentative, sero.type.rep.func, - r=r.max, r.low=r.min, comparison.type="representative") + comparison.type="independent") -## R0 of 1 plot(r.mid,sero.tau.R01$tau,ylim=c(0.3,max(geno.tau.R01$tau)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), xlab="Distance (m)",ylab="Tau",cex.main=0.9,lwd=2,type="l",las=1,cex.axis=0.75) @@ -110,10 +91,16 @@ legend("topright", "Serotype (representative population)", "Maximum transmission distance"), lwd=1,col=c("dark green","blue","blue","black"), - lty=c(1,1,2,1),bty="n") - + lty=c(1,1,2,1),bty="n") + ## R0 of 2 -plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02)),log="y", +data(DengueSimulationR02) +sero.tau.R02 <- get.tau(DengueSimR02, sero.type.func, r=r.max, r.low=r.min, + comparison.type="independent") +geno.tau.R02 <- get.tau(DengueSimR02, geno.type.func, r=r.max, r.low=r.min, + comparison.type="independent") + +plot(r.mid,sero.tau.R02$tau,ylim=c(0.3,max(geno.tau.R02$tau.pt.est)),log="y", cex.axis=1.25,col=rgb(t(col2rgb("blue")/255),alpha=0.6), xlab="Distance (m)",ylab="Tau",cex.main=0.9,lwd=2,type="l",las=1,cex.axis=0.75) abline(h=1,lty=2) @@ -125,6 +112,24 @@ legend("topright", "Maximum transmission distance"), lwd=1,col=c("dark green","blue","black"),lty=1,bty="n") +## Obtaining a diagnostic plot using plot.tau() with pointwise CIs +data(DengueSimRepresentative) +sero.type.rep.func<-function(a,b,tlimit=20){ + if(a[5]==1&b[5]==1&(abs(a[3]-b[3])<=tlimit)){rc=1} + else{if(a[5]==1&b[5]==-999){rc=2}else{rc=3}} + return(rc) +} + +# get point estimate +Dengue.tau = get.tau(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, + "representative", data.frame = TRUE) + +# get 95\% BCa CI +CIs = get.tau.ci(DengueSimRepresentative, sero.type.rep.func, r.max, r.min, 25, + "representative", ci.level = 0.95, data.frame = TRUE) + +#plot point estimate with CI +plot.tau(x = Dengue.tau, r.mid = TRUE, ptwise.CI = CIs) } } \seealso{ diff --git a/man/get.tau.bootstrap.Rd b/man/get.tau.bootstrap.Rd index 34dc8f1..524b369 100644 --- a/man/get.tau.bootstrap.Rd +++ b/man/get.tau.bootstrap.Rd @@ -40,7 +40,7 @@ calculated \examples{ \donttest{ -#compare normally distributed with uniform points +# compare normally distributed with uniform points x<-cbind(1,runif(100,-100,100), runif(100,-100,100)) x<-rbind(x, cbind(2,rnorm(100,0,20), rnorm(100,0,20))) colnames(x) <- c("type","x","y") @@ -55,16 +55,19 @@ r.max<-seq(10,100,10) r.min<-seq(0,90,10) r.mid <- (r.max+r.min)/2 -tau<-get.tau(x,fun,r=r.max,r.low=r.min) -tau.boot<-get.tau.bootstrap(x,fun,r=r.max,r.low=r.min,boot.iter=50) +tau<-get.tau(x,fun,r=r.max,r.low=r.min,"representative", data.frame = TRUE) +tau.ci = get.tau.ci(x, fun, r.max, r.min, 50, "representative", 0.95, data.frame = TRUE) -tau.ci<-apply(tau.boot[,-(1:2)],1,quantile,probs=c(0.25,0.75)) +## plot.tau() method +plot.tau(tau, r.mid = TRUE, ptwise.CI = tau.ci) -plot(r.mid, tau$tau ,ylim=c(min(tau.ci),max(tau.ci)), type="l", log="y") +## previous plot() method using connected lines to join the top and bottoms of the pointwise CIs. +#This may lead the user to perform graphical hypothesis testing using this plot without considering +#the specific distance band of interest before plotting. +plot(r.mid, tau$tau.pt.est ,ylim=c(min(tau.ci$ci.low),max(tau.ci$ci.high)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") -lines(r.mid, tau.ci[1,] , lty=2) -lines(r.mid, tau.ci[2,] , lty=2) - +lines(r.mid, tau.ci$ci.low, lty=2) +lines(r.mid, tau.ci$ci.high, lty=2) } } \seealso{ diff --git a/man/get.tau.ci.Rd b/man/get.tau.ci.Rd index df7c19e..92a26bf 100644 --- a/man/get.tau.ci.Rd +++ b/man/get.tau.ci.Rd @@ -28,11 +28,9 @@ get.tau.ci( \item{comparison.type}{the comparison type to pass to get.tau} -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} - -\item{ci.low}{the low end of the ci...0.025 by default} +\item{ci.level}{significance level of the BCa CI, default = 0.95} -\item{ci.high}{the high end of the ci...0.975 by default} +\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} } \value{ a data frame with the point estimate of tau and its low and high confidence interval at each distance @@ -59,14 +57,19 @@ r.max<-seq(10,100,10) r.min<-seq(0,90,10) r.mid <- (r.max+r.min)/2 -tau <- get.tau.ci(x,fun,r=r.max,r.low=r.min,boot.iter=50) +tau.CI <- get.tau.ci(x,fun,r=r.max,r.low=r.min,boot.iter=50, comparison.type = "representative") -plot(r.mid, tau$pt.est, ylim=c(1/max(tau[,3:5]), max(tau[,3:5])), type="l", log="y", - xlab="Distance", ylab="Tau") -lines(r.mid, tau$ci.low , lty=2) -lines(r.mid, tau$ci.high, lty=2) -lines(c(0,100),c(1,1), lty=3, col="grey") +## plot.tau() method +tau = get.tau(x,fun,r=r.max,r.low=r.min, comparison.type = "representative") +plot.tau(x = tau, ptwise.CI = tau.CI) +## previous plot() method +plot(r.mid, tau.CI$pt.est, ylim=c(min(tau.CI$pt.est,tau.CI$ci.low), + max(tau.CI$pt.est,tau.CI$ci.high)), type="l", xlab="Distance", + ylab="Tau") +lines(r.mid, tau.CI$ci.low , lty=2) +lines(r.mid, tau.CI$ci.high, lty=2) +lines(c(0,100),c(1,1), lty=3, col="grey") } } \seealso{ diff --git a/man/get.tau.permute.Rd b/man/get.tau.permute.Rd index 36f8e01..7051e85 100644 --- a/man/get.tau.permute.Rd +++ b/man/get.tau.permute.Rd @@ -60,11 +60,13 @@ tau.null<-get.tau.permute(x,fun,r=r.max,r.low=r.min,permutations=50,comparison.t null.ci<-apply(tau.null[,-(1:2)],1,quantile,probs=c(0.25,0.75)) +# note these plots are only for illustrative purposes to show how get.tau.permute() can generate +# the null distribution. These should not be used for graphical hypothesis testing nor parameter +# estimation of the clustering endpoint. plot(r.mid, tau$tau, ylim=c(1/max(tau$tau),max(tau$tau)), type="l", log="y") lines(c(0,100),c(1,1), lty=3, col="grey") lines(r.mid, null.ci[1,] , lty=2) lines(r.mid, null.ci[2,] , lty=2) - } } \seealso{ diff --git a/man/get.theta.ci.Rd b/man/get.theta.ci.Rd index 7a13fb4..21b1641 100644 --- a/man/get.theta.ci.Rd +++ b/man/get.theta.ci.Rd @@ -25,15 +25,12 @@ get.theta.ci( \item{boot.iter}{the number of bootstrap iterations} -\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} - -\item{ci.low}{the low end of the ci...0.025 by default} +\item{ci.level}{significance level of the 95% BCa CI, default = 0.95} -\item{ci.high}{the high end of the ci...0.975 by default} +\item{data.frame}{logical indicating whether to return results as a data frame (default = TRUE)} } \value{ -a matrix with a row for the high and low values and - a column per distance +a matrix with a row for the high and low values and a column per distance } \description{ Wrapper to \code{get.theta.bootstrap} that takes care of calculating the diff --git a/man/plot.tau.Rd b/man/plot.tau.Rd index 8298866..48a32a6 100644 --- a/man/plot.tau.Rd +++ b/man/plot.tau.Rd @@ -15,24 +15,26 @@ ) } \arguments{ -\item{x}{\code{tau} object. Required for all plots.} +\item{x}{\code{tau} object; create using \code{get.tau(..., data.frame = TRUE)}. Required for all plots.} \item{r.mid}{If \code{TRUE}(default) then for each point the x-coordinate of the midpoint of a distance band is plotted and if \code{FALSE} the endpoint of the distance band is plotted.} \item{tausim}{the set of spatially-bootstrapped simulations of \code{taubstrap} class; use \code{get.tau.bootstrap()} to obtain this. Required for Estimation of the clustering range plot.} -\item{ptwise.CI}{the set of pointwise CIs. Optional for the diagnostic plot but should not be supplied for the other plots.} +\item{ptwise.CI}{the set of pointwise CIs of \code{tauCI} class; create using \code{get.tau(..., data.frame = TRUE)}. Optional for the diagnostic plot but should not be supplied for the other plots.} -\item{GET.res}{is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range.} +\item{GET.res}{is a required object for the graphical hypothesis test plot but should not be supplied for the other plots. It is obtained from \code{get.tau.GET(..., data.frame = TRUE)}. It ensures that the user has performed a graphical hypothesis test first and has considered there is evidence against H_0, before deciding to estimate the clustering range.} -\item{d.param.est}{a required object for Estimating the clustering range plot but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary.} +\item{d.param.est}{a required object for Estimating the clustering range plot from \code{get.tau.D.param(..., data.frame = TRUE)}, but should not be supplied for the other plots. A \code{taubstrap} object will also be necessary.} + +\item{...}{other arguments which are standard for \code{plot()} for plot customisation} } \description{ Three types of plots: \enumerate{ \item Diagnostic plot to indicate the structure or magnitude of spatiotemporal clustering. Requires \code{tau} object; \code{tauCI} object optional to draw pointwise CIs. This plot is only suitable for the purpose of a graphical hypothesis test in the situation that a specific distance band is selected prior to graph creation. \item Graphical hypothesis test to assess the evidence against the null hypothesis (no spatiotemporal clustering nor inhibition). Requires \code{tau} and \code{tauGET} objects. -\item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau} and \code{tauparamest} objects. +\item Estimation of the clustering range (the distribution of the places on the horizontal tau=1 line, where decreasing bootstrap simulations first intercept). Requires \code{tau}, \code{tauparamest} and \code{taubstrap} objects. } } \seealso{ From 2e9e70ba87342b49075c6a007b8e66ca110449fd Mon Sep 17 00:00:00 2001 From: Tim Pollington Date: Mon, 5 Jul 2021 19:39:21 +0100 Subject: [PATCH 69/70] Typo --- man/get.tau.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/get.tau.Rd b/man/get.tau.Rd index 25d1ca5..4302cd5 100644 --- a/man/get.tau.Rd +++ b/man/get.tau.Rd @@ -19,7 +19,7 @@ columns needed by \code{fun}} \item{fun}{a function that takes in two rows of posmat and returns: \enumerate{ - \item for pairs included in the numerator (and the denominator for independent data) + \item for pairs included in the numerator (and the denominator for representative data) \item for pairs that should only be included in the denominator \item for pairs that should be ignored all together} Note that names from \code{posmat} are not preserved in calls to From 749c7a9e018661705ca31953cdd169750abaa3b1 Mon Sep 17 00:00:00 2001 From: t-pollington Date: Wed, 21 Jul 2021 13:45:57 +0100 Subject: [PATCH 70/70] Moving so that devtools::test() works. --- {inst/tests => tests/testthat}/test-getpi.r | 0 {inst/tests => tests/testthat}/test-getpibootstrap.r | 0 {inst/tests => tests/testthat}/test-getpipermute.r | 0 {inst/tests => tests/testthat}/test-gettau.r | 0 {inst/tests => tests/testthat}/test-gettaubootstrap.r | 0 {inst/tests => tests/testthat}/test-gettaupermute.r | 0 {inst/tests => tests/testthat}/test-gettheta.r | 0 {inst/tests => tests/testthat}/test-getthetabootstrap.r | 0 {inst/tests => tests/testthat}/test-getthetapermute.r | 0 {inst/tests => tests/testthat}/test-simulateepidemic.r | 0 {inst/tests => tests/testthat}/test-thetaweights.r | 0 {inst/tests => tests/testthat}/test-transdist.r | 0 {inst/tests => tests/testthat}/test-transdistbootstrapci.r | 0 {inst/tests => tests/testthat}/test-transdisttemporal.r | 0 {inst/tests => tests/testthat}/test-wallingateunis.r | 0 {inst/tests => tests/testthat}/test-wrapperfuncs.r | 0 16 files changed, 0 insertions(+), 0 deletions(-) rename {inst/tests => tests/testthat}/test-getpi.r (100%) rename {inst/tests => tests/testthat}/test-getpibootstrap.r (100%) rename {inst/tests => tests/testthat}/test-getpipermute.r (100%) rename {inst/tests => tests/testthat}/test-gettau.r (100%) rename {inst/tests => tests/testthat}/test-gettaubootstrap.r (100%) rename {inst/tests => tests/testthat}/test-gettaupermute.r (100%) rename {inst/tests => tests/testthat}/test-gettheta.r (100%) rename {inst/tests => tests/testthat}/test-getthetabootstrap.r (100%) rename {inst/tests => tests/testthat}/test-getthetapermute.r (100%) rename {inst/tests => tests/testthat}/test-simulateepidemic.r (100%) rename {inst/tests => tests/testthat}/test-thetaweights.r (100%) rename {inst/tests => tests/testthat}/test-transdist.r (100%) rename {inst/tests => tests/testthat}/test-transdistbootstrapci.r (100%) rename {inst/tests => tests/testthat}/test-transdisttemporal.r (100%) rename {inst/tests => tests/testthat}/test-wallingateunis.r (100%) rename {inst/tests => tests/testthat}/test-wrapperfuncs.r (100%) diff --git a/inst/tests/test-getpi.r b/tests/testthat/test-getpi.r similarity index 100% rename from inst/tests/test-getpi.r rename to tests/testthat/test-getpi.r diff --git a/inst/tests/test-getpibootstrap.r b/tests/testthat/test-getpibootstrap.r similarity index 100% rename from inst/tests/test-getpibootstrap.r rename to tests/testthat/test-getpibootstrap.r diff --git a/inst/tests/test-getpipermute.r b/tests/testthat/test-getpipermute.r similarity index 100% rename from inst/tests/test-getpipermute.r rename to tests/testthat/test-getpipermute.r diff --git a/inst/tests/test-gettau.r b/tests/testthat/test-gettau.r similarity index 100% rename from inst/tests/test-gettau.r rename to tests/testthat/test-gettau.r diff --git a/inst/tests/test-gettaubootstrap.r b/tests/testthat/test-gettaubootstrap.r similarity index 100% rename from inst/tests/test-gettaubootstrap.r rename to tests/testthat/test-gettaubootstrap.r diff --git a/inst/tests/test-gettaupermute.r b/tests/testthat/test-gettaupermute.r similarity index 100% rename from inst/tests/test-gettaupermute.r rename to tests/testthat/test-gettaupermute.r diff --git a/inst/tests/test-gettheta.r b/tests/testthat/test-gettheta.r similarity index 100% rename from inst/tests/test-gettheta.r rename to tests/testthat/test-gettheta.r diff --git a/inst/tests/test-getthetabootstrap.r b/tests/testthat/test-getthetabootstrap.r similarity index 100% rename from inst/tests/test-getthetabootstrap.r rename to tests/testthat/test-getthetabootstrap.r diff --git a/inst/tests/test-getthetapermute.r b/tests/testthat/test-getthetapermute.r similarity index 100% rename from inst/tests/test-getthetapermute.r rename to tests/testthat/test-getthetapermute.r diff --git a/inst/tests/test-simulateepidemic.r b/tests/testthat/test-simulateepidemic.r similarity index 100% rename from inst/tests/test-simulateepidemic.r rename to tests/testthat/test-simulateepidemic.r diff --git a/inst/tests/test-thetaweights.r b/tests/testthat/test-thetaweights.r similarity index 100% rename from inst/tests/test-thetaweights.r rename to tests/testthat/test-thetaweights.r diff --git a/inst/tests/test-transdist.r b/tests/testthat/test-transdist.r similarity index 100% rename from inst/tests/test-transdist.r rename to tests/testthat/test-transdist.r diff --git a/inst/tests/test-transdistbootstrapci.r b/tests/testthat/test-transdistbootstrapci.r similarity index 100% rename from inst/tests/test-transdistbootstrapci.r rename to tests/testthat/test-transdistbootstrapci.r diff --git a/inst/tests/test-transdisttemporal.r b/tests/testthat/test-transdisttemporal.r similarity index 100% rename from inst/tests/test-transdisttemporal.r rename to tests/testthat/test-transdisttemporal.r diff --git a/inst/tests/test-wallingateunis.r b/tests/testthat/test-wallingateunis.r similarity index 100% rename from inst/tests/test-wallingateunis.r rename to tests/testthat/test-wallingateunis.r diff --git a/inst/tests/test-wrapperfuncs.r b/tests/testthat/test-wrapperfuncs.r similarity index 100% rename from inst/tests/test-wrapperfuncs.r rename to tests/testthat/test-wrapperfuncs.r