Improve support for region parameter

ms609 · Jan 11, 2024 · d0bb4bb · d0bb4bb
1 parent 0024c49
commit d0bb4bb
Show file tree

Hide file tree

Showing 8 changed files with 789 additions and 778 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: Ternary
-Version: 2.3.0
+Version: 2.3.0.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/NEWS.md b/NEWS.md
@@ -1,3 +1,6 @@
+# Ternary v2.3.0.9000 (development)
+- Improve support for `region` parameter.
+
 # Ternary v2.3.0 (2024-01-08)
 - `region` parameter plots a sub-region of the ternary space.
 - Support `...`  in `TernaryContour(Func = function(...))`

diff --git a/R/SetRegion.R b/R/SetRegion.R
@@ -205,8 +205,12 @@ ternRegionA <- structure(
         i <- c(i, seq(max(i) + by, by = by, length.out = longest - n))
         i
       })
-    prettyRegion <- rbind(min = vapply(prettyRegion, `[`, 0, 1),
-                          max = vapply(prettyRegion, `[`, 0, longest))
+    prettyRegion <- structure(
+      rbind(min = vapply(prettyRegion, `[`, 0, 1),
+            max = vapply(prettyRegion, `[`, 0, longest)),
+      tickLabels = prettyRegion,
+      class = "ternRegion"
+    )
     if (.RegionIsValid(prettyRegion)) {
       region <- prettyRegion
     }

diff --git a/R/TernaryPlot.R b/R/TernaryPlot.R
@@ -234,7 +234,7 @@ TernaryPlot <- function(atip = NULL, btip = NULL, ctip = NULL,
 
   .PlotBackground(tern)
 
-  panel.first
+  panel.first # Execute user-supplied expression
 
   .PlotMinorGridLines(
     tern$grid.lines,
@@ -251,7 +251,7 @@ TernaryPlot <- function(atip = NULL, btip = NULL, ctip = NULL,
     lwd = tern$grid.lwd
   )
 
-  panel.last
+  panel.last # Execute user-supplied expression
 
   .PlotAxisTicks(tern)
 

diff --git a/R/dot-TrianglePlot.R b/R/dot-TrianglePlot.R
@@ -160,8 +160,9 @@
   }
 
   region <- getOption("ternRegion")
-  if (isTRUE(axis.labels) && !all(region == ternRegionDefault)) {
-    axis.labels <- .SimpleApply(region, 2, pretty, n = grid.lines)
+  region.labels <- attr(region, "tickLabels")
+  if (isTRUE(axis.labels) && !is.null(region.labels)) {
+    axis.labels <- region.labels
     grid.lines <- length(axis.labels[[1]]) - 1L
   } else {
     grid.lines <- .ValidateGridLines(grid.lines)

diff --git a/tests/testthat/_snaps/Contours/contours.svg b/tests/testthat/_snaps/Contours/contours.svg
diff --git a/tests/testthat/_snaps/Contours/filledcontours.svg b/tests/testthat/_snaps/Contours/filledcontours.svg
diff --git a/tests/testthat/test-SetRegion.R b/tests/testthat/test-SetRegion.R
@@ -98,7 +98,11 @@ test_that(".SetRegion() prettifies", {
   expect_equal(getOption("ternRegion"), structure(region, class = "ternRegion"))
 
   .SetRegion(regionList, prettify = 10)
-  expect_equal(getOption("ternRegion"), structure(pretty, class = "ternRegion"))
+  expect_equal(getOption("ternRegion"), structure(
+    pretty,
+    tickLabels = list(a = 10:20, b = 10:20, c = 70:80),
+    class = "ternRegion")
+  )
 })
 
 test_that(".SetRegion() handles bad input", {
@@ -116,8 +120,6 @@ test_that(".SetRegion() handles bad input", {
   )
   expect_equal(getOption("ternRegion"), ternRegionDefault)
 
-  .SetRegion(ternRegion20)
-
   .SetRegion(ternRegion20)
   expect_warning(
     expect_equal(
@@ -128,6 +130,7 @@ test_that(".SetRegion() handles bad input", {
   )
   expect_equal(getOption("ternRegion"), ternRegion20)
 
+  .SetRegion(ternRegion20)
   expect_warning(
     expect_equal(
       .SetRegion(list(min = rep(0, 3), max = rep(0, 3)), set = 0),