diff --git a/NAMESPACE b/NAMESPACE index 36d0c1d6f5333a6d0fdd3c431298200b9a2d0aac..a0b1a5eb7076ba981d4563a1bc19de81205f47b9 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ export(ecxsys) export(lc) +export(log10_ticks) export(multi_tox) export(plot_stress) export(plot_survival) diff --git a/NEWS.md b/NEWS.md index 0d9f1d7f2aa6f788d63bb88effdd2fd0a46d79d0..d24a94faca4245ace7322f8e437c82682c806854 100644 --- a/NEWS.md +++ b/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 diff --git a/R/get_log_ticks.R b/R/get_log_ticks.R deleted file mode 100644 index 6063045a9c9f3af4e57d0758fbc031c0ce545a71..0000000000000000000000000000000000000000 --- a/R/get_log_ticks.R +++ /dev/null @@ -1,43 +0,0 @@ -# Copyright (C) 2020 Helmholtz-Zentrum fuer Umweltforschung GmbH - UFZ -# See file inst/COPYRIGHTS for details. -# -# This file is part of the R package stressaddition. -# -# stressaddition is free software: you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation, either version 3 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# 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. - stopifnot(min(x, na.rm = TRUE) > 0) - x <- log10(x) - major <- 10 ^ seq( - floor(min(x, na.rm = TRUE)), - ceiling(max(x, na.rm = TRUE)) - ) - n_between <- length(major) - 1 - minor <- integer(n_between * 8) - for (i in 1:n_between) { - a <- major[i] - 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" - list( - major = major, - minor = minor, - major_labels = major_tick_labels - ) -} diff --git a/R/log10_ticks.R b/R/log10_ticks.R new file mode 100644 index 0000000000000000000000000000000000000000..3f5fd58249223e699e286fded43c9aa792618a3d --- /dev/null +++ b/R/log10_ticks.R @@ -0,0 +1,72 @@ +# Copyright (C) 2020 Helmholtz-Zentrum fuer Umweltforschung GmbH - UFZ +# See file inst/COPYRIGHTS for details. +# +# This file is part of the R package stressaddition. +# +# stressaddition is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + + +#' 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 <- 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) { + a <- major[i] + b <- major[i + 1] + minor[seq(i * 8 - 7, i * 8)] <- seq(a + a, b - a, a) + } + + 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_labels, + minor_labels = minor_labels + ) +} diff --git a/R/plot_stress.R b/R/plot_stress.R index 8bbd4b2f8b1d08eb28fca29ab137e8969d645f60..1d702a9e55951ae3508bd7bc9afa9fa83c14cfe0 100644 --- a/R/plot_stress.R +++ b/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) diff --git a/R/plot_survival.R b/R/plot_survival.R index 7cbe6cc0d6484f54763f38e5641e97aa4dc21a19..7963504d254cb2f59f6f78a7426e442b4b67930b 100644 --- a/R/plot_survival.R +++ b/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) diff --git a/man/log10_ticks.Rd b/man/log10_ticks.Rd new file mode 100644 index 0000000000000000000000000000000000000000..e83aa0b21a6dde733b5f81d1f8949ce561783cdd --- /dev/null +++ b/man/log10_ticks.Rd @@ -0,0 +1,34 @@ +% 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) + +} diff --git a/tests/testthat/test-get_log_ticks.R b/tests/testthat/test-log10_ticks.R similarity index 50% rename from tests/testthat/test-get_log_ticks.R rename to tests/testthat/test-log10_ticks.R index a0dea0a1d6556b76502c4c736e53120584fc2964..3f6f93d6678a17ec0548167d602ffb258b93ab5c 100644 --- a/tests/testthat/test-get_log_ticks.R +++ b/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)) }) diff --git a/tests/testthat/test-options.R b/tests/testthat/test-options.R index 58f979e3ef5d7c17eb02aab54e34ea66ea8f7d25..2a4f03c307c07439632e826e90ee8405fdf87a65 100644 --- a/tests/testthat/test-options.R +++ b/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(