Export log10_ticks(), closes #45,

renamed and slightly modified from get_log_ticks(), now with minor tick labels

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(ecxsys)
 export(lc)
+export(log10_ticks)
 export(multi_tox)
 export(plot_stress)
 export(plot_survival)

NEWS.md

@@ -6,6 +6,7 @@
 * The argument `proportion_ca` in the mixture model `multi_tox()` was renamed and its value reversed. It is now called `sa_contribution` and specifies the proportion of stress addition in the calculation of toxicant stress. To convert your code from the old version use this equation: sa_contribution = 1 - proportion_ca.
 * Renamed `stress_tox_sam` to `stress_tox_sa` in the output of `multi_tox()`.
 * Fixed a bug where `plot_stress()` with argument `which = NULL` would result in an error. Now it correctly draws the axes without data.
+* Newly exported function `log10_ticks()` for calculating tick mark labels and positions on a base 10 logarithmic axis.
 
 # stressaddition 2.7.0
 

R/get_log_ticks.R → R/log10_ticks.R

@@ -17,15 +17,38 @@
 # along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 
-get_log_ticks <- function(x) {
-    # Calculate the positions of major and minor tick marks on a base 10
-    # logarithmic axis.
+#' Logarithmic axis tick marks
+#'
+#' Calculate the positions and labels of major and minor tick marks for a base
+#' 10 logarithmic axis.
+#'
+#' @param x A vector of axis values. Can be arbitrarily long but only the
+#'   minimum and maximum are necessary.
+#' @param label_zero Whether or not to replace the smallest major label with
+#'   "0". This defaults to \code{TRUE} and is useful for some types of plots
+#'   used to display concentration-response data where the leftmost data point
+#'   represents the control.
+#'
+#' @return A list with the positions and labels of the major and minor tick
+#'   marks. The labels are formatted without trailing zeros using
+#'   \code{formatC(labels, format = "fg")}.
+#'
+#' @examples
+#' x <- c(0.01, 0.2, 3, 10, 50)
+#' plot(x, c(5, 4, 2.5, 1, 0), xaxt = "n", log = "x")
+#' ticks <- log10_ticks(x)
+#' axis(1, at = ticks$major, labels = ticks$major_labels)
+#' axis(1, at = ticks$minor, labels = FALSE, tcl = -0.25)
+#'
+#' @export
+log10_ticks <- function(x, label_zero = TRUE) {
     stopifnot(min(x, na.rm = TRUE) > 0)
     x <- log10(x)
-    major <- 10 ^ seq(
+    major <- seq(
         floor(min(x, na.rm = TRUE)),
         ceiling(max(x, na.rm = TRUE))
     )
+    major <- 10 ^ major
     n_between <- length(major) - 1
     minor <- integer(n_between * 8)
     for (i in 1:n_between) {
@@ -33,11 +56,17 @@ get_log_ticks <- function(x) {
         b <- major[i + 1]
         minor[seq(i * 8 - 7, i * 8)] <- seq(a + a, b - a, a)
     }
-    major_tick_labels <- formatC(major, format = "fg")
-    major_tick_labels[1] <- "0"
+
+    major_labels <- formatC(major, format = "fg")
+    if (label_zero) {
+        major_labels[1] <- "0"
+    }
+    minor_labels <- formatC(minor, format = "fg")
+
     list(
         major = major,
         minor = minor,
-        major_labels = major_tick_labels
+        major_labels = major_labels,
+        minor_labels = minor_labels
     )
 }

R/plot_stress.R

@@ -52,7 +52,7 @@ plot_stress <- function(model,
     }
 
     curves <- model$curves
-    log_ticks <- get_log_ticks(curves$concentration_for_plots)
+    ticks <- log10_ticks(curves$concentration_for_plots)
     point_concentration <- c(
         curves$concentration_for_plots[1],
         model$args$concentration[-1]
@@ -162,9 +162,9 @@ plot_stress <- function(model,
     # The setting of col = NA and col.ticks = par("fg") is to prevent ugly line
     # thickness issues when plotting as a png with type = "cairo" and at a low
     # resolution.
-    axis(1, at = log_ticks$major, labels = log_ticks$major_labels,
+    axis(1, at = ticks$major, labels = ticks$major_labels,
          col = NA, col.ticks = par("fg"))
-    axis(1, at = log_ticks$minor, labels = FALSE, tcl = -0.25,
+    axis(1, at = ticks$minor, labels = FALSE, tcl = -0.25,
          col = NA, col.ticks = par("fg"))
     plotrix::axis.break(1, breakpos = model$axis_break_conc)
     axis(2, col = NA, col.ticks = par("fg"), las = 1)

R/plot_survival.R

@@ -53,7 +53,7 @@ plot_survival <- function(model,
     }
 
     curves <- model$curves
-    log_ticks <- get_log_ticks(curves$concentration_for_plots)
+    ticks <- log10_ticks(curves$concentration_for_plots)
     point_concentration <- c(
         curves$concentration_for_plots[1],
         model$args$concentration[-1]
@@ -143,9 +143,9 @@ plot_survival <- function(model,
     # The setting of col = NA and col.ticks = par("fg") is to prevent ugly line
     # thickness issues when plotting as a png with type = "cairo" and at a low
     # resolution.
-    axis(1, at = log_ticks$major, labels = log_ticks$major_labels,
+    axis(1, at = ticks$major, labels = ticks$major_labels,
          col = NA, col.ticks = par("fg"))
-    axis(1, at = log_ticks$minor, labels = FALSE, tcl = -0.25,
+    axis(1, at = ticks$minor, labels = FALSE, tcl = -0.25,
          col = NA, col.ticks = par("fg"))
     plotrix::axis.break(1, breakpos = model$axis_break_conc)
     axis(2, col = NA, col.ticks = par("fg"), las = 1)

man/log10_ticks.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/log10_ticks.R
+\name{log10_ticks}
+\alias{log10_ticks}
+\title{Logarithmic axis tick marks}
+\usage{
+log10_ticks(x, label_zero = TRUE)
+}
+\arguments{
+\item{x}{A vector of axis values. Can be arbitrarily long but only the
+minimum and maximum are necessary.}
+
+\item{label_zero}{Whether or not to replace the smallest major label with
+"0". This defaults to \code{TRUE} and is useful for some types of plots
+used to display concentration-response data where the leftmost data point
+represents the control.}
+}
+\value{
+A list with the positions and labels of the major and minor tick
+  marks. The labels are formatted without trailing zeros using
+  \code{formatC(labels, format = "fg")}.
+}
+\description{
+Calculate the positions and labels of major and minor tick marks for a base
+10 logarithmic axis.
+}
+\examples{
+x <- c(0.01, 0.2, 3, 10, 50)
+plot(x, c(5, 4, 2.5, 1, 0), xaxt = "n", log = "x")
+ticks <- log10_ticks(x)
+axis(1, at = ticks$major, labels = ticks$major_labels)
+axis(1, at = ticks$minor, labels = FALSE, tcl = -0.25)
+
+}

tests/testthat/test-get_log_ticks.R → tests/testthat/test-log10_ticks.R

@@ -18,13 +18,25 @@
 
 
 test_that("log ticks are correct", {
-  x <- c(0.03, 0.3, 3, 30)
-  ticks <- get_log_ticks(x)
-  expect_equal(ticks$major, c(0.01, 0.10, 1.00, 10.00, 100.00))
-  expect_equal(ticks$major_labels, c("0", "0.1", "1", "10", "100"))
-  expect_equal(
-      ticks$minor,
-      c(0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09, 0.20, 0.30, 0.40, 0.50,
-        0.60, 0.70, 0.80, 0.90, 2.00, 3.00, 4.00, 5.00, 6.00, 7.00, 8.00, 9.00,
-        20.00, 30.00, 40.00, 50.00, 60.00, 70.00, 80.00, 90.00))
+    x <- c(0.03, 0.3, 3, 30)
+    reference <- list(
+        major = c(0.01, 0.1, 1, 10, 100),
+        minor = c(
+            0.02, 0.03, 0.04, 0.05, 0.06, 0.07, 0.08, 0.09,
+            0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9,
+            2, 3, 4, 5, 6, 7, 8, 9,
+            20, 30, 40, 50, 60, 70, 80, 90
+        ),
+        major_labels = c("0", "0.1", "1", "10", "100"),
+        minor_labels = c(
+            "0.02", "0.03", "0.04", "0.05", "0.06", "0.07", "0.08", "0.09",
+            "0.2", "0.3", "0.4", "0.5", "0.6", "0.7", "0.8", "0.9",
+            "2", "3", "4", "5", "6", "7", "8", "9",
+            "20", "30", "40", "50", "60", "70", "80", "90"
+        )
+    )
+    expect_equal(reference, log10_ticks(x))
+
+    reference$major_labels[1] <- "0.01"
+    expect_equal(reference, log10_ticks(x, label_zero = FALSE))
 })

tests/testthat/test-options.R

@@ -26,6 +26,7 @@ test_that("user options are not permanently changed by ecxsys()", {
     # This problem becomes visible only if the user changes the default options:
     options(show.error.messages = FALSE)  #  default is TRUE
     options(warn = 1)  # default is 0
+    on.exit(options(warn = 0))
 
     original_options <- options()
     model <- ecxsys(