Subregion plotting (#80)

* update contour plotting testcases per PlotTools 0.3.0 * R3.6 required for testthat * .SimpleApply() for R<4.1
ms609 · Jan 4, 2024 · bb8003c · bb8003c
1 parent 88c83dd
commit bb8003c
Show file tree

Hide file tree

Showing 39 changed files with 11,927 additions and 11,998 deletions.
diff --git a/.github/workflows/R-CMD-check.yml b/.github/workflows/R-CMD-check.yml
@@ -1,8 +1,6 @@
 # For help debugging build failures open an issue on the RStudio community with the 'github-actions' tag.
 # https://community.rstudio.com/new-topic?category=Package%20development&tags=github-actions
 on:
-  schedule:
-    - cron: "03 03 * * 1"
   push:
     branches:
       - main
@@ -48,7 +46,7 @@ jobs:
         config:
           - {os: windows-latest, r: 'release'}
           - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: '3.5.3', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: ubuntu-20.04, r: '3.6', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
           - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
           - {os: ubuntu-20.04, r: 'devel', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
 

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: Ternary
-Version: 2.2.1
+Version: 2.2.1.9000
 Title: Create Ternary and Holdridge Plots
 Description: Plots ternary diagrams (simplex plots / Gibbs triangles) and
   Holdridge life zone plots <doi:10.1126/science.105.2727.367> using the

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,7 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(.SetRegion,data.frame)
+S3method(.SetRegion,list)
+S3method(.SetRegion,matrix)
+S3method(.SetRegion,ternRegion)
 S3method(TernaryToXY,matrix)
 S3method(TernaryToXY,numeric)
+export(.SetRegion)
 export(AddToHoldridge)
 export(AddToTernary)
 export(Annotate)

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# Ternary v2.2.1.9000 (development, 2024-01-03)
+  - Option to plot smaller region of ternary plot (in progress).
+
 # Ternary v2.2.1 (2023-06-28)
   - `Polygon-Geometry` now imported from PlotTools. Aliases of these functions
     are provided but will be removed in a later version of this package.

diff --git a/R/Contours.R b/R/Contours.R
@@ -602,7 +602,7 @@ ColorTernary <- ColourTernary
 #'
 #' @template FuncParam
 #' @template resolutionParam
-#' @template directionParam
+#' @inheritParams TernaryPlot
 #' @template dotsToContour
 #' @template legendParam
 #' @param legend... List of additional parameters to send to
@@ -668,6 +668,7 @@ ColorTernary <- ColourTernary
 #' @export
 TernaryContour <- function(
     Func, resolution = 96L, direction = getOption("ternDirection", 1L),
+    region = getOption("ternRegion", ternRegionDefault),
     within = NULL, filled = FALSE, legend, legend... = list(),
     nlevels = 10, levels = pretty(zlim, nlevels), zlim,
     color.palette = function(n) viridisLite::viridis(n, alpha = 0.6),
@@ -688,7 +689,7 @@ TernaryContour <- function(
   }
 
   if (is.null(within)) {
-    within <- GrowPolygon(t(TernaryToXY(diag(3))),
+    within <- GrowPolygon(t(TernaryToXY(.RegionCorners(region))),
                           buffer = 1 / resolution)
   } else {
     within <- xy.coords(within)

diff --git a/R/Coordinates.R b/R/Coordinates.R
@@ -17,6 +17,7 @@
 #' @param b_coord The b coordinate, if \code{abc} is a single number.
 #' @param c_coord The c coordinate, if \code{abc} is a single number.
 #' @template directionParam
+#' @inheritParams TernaryPlot
 #'
 #' @return `TernaryCoords()` returns a vector of length two that converts
 #' the coordinates given in `abc` into Cartesian (_x_, _y_) coordinates
@@ -34,16 +35,22 @@
 #' @family coordinate translation functions
 #' @template MRS
 #' @export
-TernaryCoords <- function(abc, b_coord = NULL, c_coord = NULL,
-                          direction = getOption("ternDirection", 1L)) {
+TernaryCoords <- function(
+    abc, b_coord = NULL, c_coord = NULL,
+    direction = getOption("ternDirection", 1L),
+    region = getOption("ternRegion", ternRegionDefault)
+  ) {
   UseMethod("TernaryToXY")
 }
 
 #' @rdname TernaryCoords
 #' @export
-TernaryToXY.matrix <- function(abc, b_coord = NULL, c_coord = NULL,
-                               direction = getOption("ternDirection", 1L)) {
-  ret <- apply(abc, 2, TernaryToXY, direction = direction)
+TernaryToXY.matrix <- function(
+    abc, b_coord = NULL, c_coord = NULL,
+    direction = getOption("ternDirection", 1L),
+    region = getOption("ternRegion", ternRegionDefault)
+  ) {
+  ret <- apply(abc, 2, TernaryToXY, direction = direction, region = region)
   rownames(ret) <- c("x", "y")
 
   # Return:
@@ -52,8 +59,11 @@ TernaryToXY.matrix <- function(abc, b_coord = NULL, c_coord = NULL,
 
 #' @rdname TernaryCoords
 #' @export
-TernaryToXY.numeric <- function(abc, b_coord = NULL, c_coord = NULL,
-                                direction = getOption("ternDirection", 1L)) {
+TernaryToXY.numeric <- function(
+    abc, b_coord = NULL, c_coord = NULL,
+    direction = getOption("ternDirection", 1L),
+    region = getOption("ternRegion", ternRegionDefault)
+  ) {
   if (!is.null(b_coord) && !is.null(c_coord)) {
     abc <- c(abc, b_coord, c_coord)
   }
@@ -66,9 +76,8 @@ TernaryToXY.numeric <- function(abc, b_coord = NULL, c_coord = NULL,
   if (!(direction %in% 1:4)) {
     stop("Parameter `direction` must be 1, 2, 3 or 4")
   }
-  names(abc) <- NULL # or they may be inherited by x and y, confusingly
-
-  abc <- abc[switch(direction,
+  # unname to avoid x and y inheriting names
+  abc <- unname(abc)[switch(direction,
     c(2, 3, 1),
     c(3, 2, 1),
     c(3, 2, 1),
@@ -84,13 +93,16 @@ TernaryToXY.numeric <- function(abc, b_coord = NULL, c_coord = NULL,
     x <- x_deviation * cos(pi / 6)
     y <- y_deviation * (1 - x_deviation) / 2
   }
-
+  
   # Return:
-  switch(direction,
-    c(y, x),
-    c(x, y),
-    c(y, -x),
-    c(-x, y)
+  .NormalizeToRegion(
+    switch(direction,
+      c(y, x),
+      c(x, y),
+      c(y, -x),
+      c(-x, y)
+    ),
+    region = region
   )
 }
 
@@ -105,6 +117,7 @@ TernaryToXY <- TernaryCoords
 #' @param x,y Numeric values giving the _x_ and _y_ coordinates of a point or
 #' points.
 #' @template directionParam
+#' @inheritParams TernaryPlot
 #'
 #' @return `XYToTernary()` Returns the ternary point(s) corresponding to the
 #' specified _x_ and _y_ coordinates, where a + b + c = 1.
@@ -115,10 +128,24 @@ TernaryToXY <- TernaryCoords
 #'
 #' @family coordinate translation functions
 #' @export
-XYToTernary <- function(x, y, direction = getOption("ternDirection", 1L)) {
-  if (!is.numeric(x)) stop("Parameter `x` must be numeric.")
-  if (!is.numeric(y)) stop("Parameter `y` must be numeric.")
-  if (!(direction %in% 1:4)) stop("Parameter direction must be 1, 2, 3 or 4")
+XYToTernary <- function(
+    x, y,
+    direction = getOption("ternDirection", 1L),
+    region = getOption("ternRegion", ternRegionDefault)
+  ) {
+  if (!is.numeric(x)) {
+    stop("Parameter `x` must be numeric.")
+  }
+  if (!is.numeric(y)) {
+    stop("Parameter `y` must be numeric.")
+  }
+  if (!(direction %in% 1:4)) {
+    stop("Parameter direction must be 1, 2, 3 or 4")
+  }
+
+  xy <- .UnnormalizeXY(x, y)
+  x <- xy[[1]]
+  y <- xy[[2]]
 
   if (direction == 1L) {
     a <- y / sqrt(0.75)
@@ -269,8 +296,10 @@ OutsidePlot <- function(x, y, tolerance = 0) {
 #' points(ref[[3]][, 1], ref[[3]][, 2], col = "orange", pch = 3)
 #' @family coordinate translation functions
 #' @export
-ReflectedEquivalents <- function(x, y,
-                                 direction = getOption("ternDirection", 1L)) {
+ReflectedEquivalents <- function(
+    x, y,
+    direction = getOption("ternDirection", 1L)
+  ) {
   switch(direction,
     {
       # 1L

diff --git a/R/Holdridge.R b/R/Holdridge.R
@@ -13,6 +13,8 @@
 #' [`HoldridgeBelts()`] and [`HoldridgeHexagons()`] plot interpretative lines
 #' and hexagons allowing plotted data to be linked to interpreted climate
 #' settings.
+#' 
+#' Please cite Tsakalos _et al._ (2023) when using this function.
 #'
 #' @inheritParams TernaryPlot
 #'
@@ -29,6 +31,10 @@
 #'
 #' Holdridge (1967), _[Life zone ecology]_.
 #' Tropical Science Center, San Jos&eacute;
+#' 
+#' Tsakalos, Smith, Luebert & Mucina (2023).
+#' "climenv: Download, extract and visualise climatic and elevation data.",
+#' _Journal of Vegetation Science_ 6:e13215. \doi{10.1111/jvs.13215}
 #'
 #' [Life zone ecology]: https://reddcr.go.cr/sites/default/files/centro-de-documentacion/holdridge_1966_-_life_zone_ecology.pdf
 #'
@@ -46,7 +52,7 @@ HoldridgePlot <- function(atip = NULL, btip = NULL, ctip = NULL,
                           clab = "Humidity province",
                           lab.offset = 0.22,
                           lab.col = c("#D81B60", "#1E88E5", "#111111"),
-                          xlim = NULL, ylim = NULL,
+                          xlim = NULL, ylim = NULL, region = NULL,
                           lab.cex = 1.0,
                           lab.font = 0,
                           tip.cex = lab.cex,
@@ -88,6 +94,7 @@ HoldridgePlot <- function(atip = NULL, btip = NULL, ctip = NULL,
                           ticks.length = 0.025,
                           ticks.col = grid.col,
                           ...) {
+  .SetRegion(ternRegionDefault)
   tri <- .TrianglePlot(
     atip = atip, btip = btip, ctip = ctip,
     alab = alab, blab = blab, clab = clab,