From 96d3fc6fd1663656ace5e58cfeb5777cfd8130a2 Mon Sep 17 00:00:00 2001 From: Unknown Date: Thu, 22 Sep 2022 11:19:51 -0400 Subject: [PATCH] Fixes #381 Prevent log ticks from crashing plots --- NAMESPACE | 1 + R/error-checks.R | 21 +++++++++++++ R/helpers.R | 25 +++++++++++++++ R/plotconfiguration-axis.R | 45 ++++++++++++++++++++++++--- man/dot-isLogTicksIncludedInLimits.Rd | 17 ++++++++++ man/isBetween.Rd | 34 ++++++++++++++++++++ tests/testthat/test-axes.R | 31 ++++++++++++++++++ 7 files changed, 169 insertions(+), 5 deletions(-) create mode 100644 man/dot-isLogTicksIncludedInLimits.Rd create mode 100644 man/isBetween.Rd create mode 100644 tests/testthat/test-axes.R diff --git a/NAMESPACE b/NAMESPACE index cf0f5be8..e088d696 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -126,6 +126,7 @@ export(getSameLimits) export(getSqrtTickLabels) export(getSymmetricLimits) export(initializePlot) +export(isBetween) export(loadThemeFromJson) export(plotBoxWhisker) export(plotCumulativeTimeProfile) diff --git a/R/error-checks.R b/R/error-checks.R index 9948bd74..4c0f416f 100644 --- a/R/error-checks.R +++ b/R/error-checks.R @@ -39,3 +39,24 @@ } stop(messages$errorConflictingInput(names(eitherInput), names(orInput))) } + +#' Check that at least one log tick is included in limits +#' +#' @param limits An array of numeric values +#' @param scale Name of log scale: `Scaling$log` for log10 scale, `Scaling$ln` for logarithmic scale +#' @keywords internal +.isLogTicksIncludedInLimits <- function(limits, scale){ + minLimit <- min(limits, na.rm = TRUE) + maxLimit <- max(limits, na.rm = TRUE) + exponentValues <- switch( + scale, + "log" = seq(floor(log10(minLimit)), ceiling(log10(maxLimit))), + "ln" = seq(floor(log(minLimit)), ceiling(log(maxLimit))) + ) + logTicks <- rep(seq(1, 9), length(exponentValues)) * switch( + scale, + "log" = 10^rep(exponentValues, each = 9), + "ln" = exp(rep(exponentValues, each = 9)) + ) + return(sum(isBetween(logTicks, minLimit, maxLimit))>0) +} \ No newline at end of file diff --git a/R/helpers.R b/R/helpers.R index 72074db1..a4b796f0 100644 --- a/R/helpers.R +++ b/R/helpers.R @@ -1,3 +1,28 @@ +#' @title isBetween +#' @description Assess if `x` is between `left` and `right` bounds. +#' Shortcut for `x >= left & x <= right` if `strict=FALSE` (default). +#' Shortcut for `x > left & x < right` if `strict=TRUE`. +#' @param x Numeric values to assess +#' @param left Numeric value(s) used as lower bound +#' @param right Numeric value(s) used as upper bound +#' @param strict Logical value defining if `x` is strictly between `left` and `right`. +#' Default value is `FALSE`. +#' @return Logical values +#' @export +#' @examples +#' isBetween(1:12, 7, 9) +#' +#' x <- rnorm(1e2) +#' x[isBetween(x, -1, 1)] +#' +#' isBetween(x, cos(x) + 1, cos(x) - 1) +isBetween <- function(x, left, right, strict = FALSE) { + if (strict) { + return(x > left & x < right) + } + return(x >= left & x <= right) +} + #' @title getSymmetricLimits #' @description Get symmetric limits from a set of values #' @param values numeric values diff --git a/R/plotconfiguration-axis.R b/R/plotconfiguration-axis.R index ff021d5e..d90dadf1 100644 --- a/R/plotconfiguration-axis.R +++ b/R/plotconfiguration-axis.R @@ -320,14 +320,31 @@ XAxisConfiguration <- R6::R6Class( oob = .removeInfiniteValues ) ) + if(!isIncluded(private$.scale, c(Scaling$log, Scaling$ln))){ + return(plotObject) + } + # Checks that the final plot limits include at least one pretty log tick + plotScaleData <- ggplot2::layer_scales(plotObject) + xDataRange <- switch( + private$.scale, + "log" = 10^plotScaleData$x$range$range, + "ln" = exp(plotScaleData$x$range$range) + ) + if(!isEmpty(private$.limits)){ + xDataRange <- private$.limits + } + + if(!.isLogTicksIncludedInLimits(xDataRange, private$.scale)){ + return(plotObject) + } # Add special tick lines for pretty log plots - suppressMessages( + suppressMessages({ plotObject <- switch(private$.scale, "log" = plotObject + ggplot2::annotation_logticks(sides = "b", color = private$.font$color), "ln" = plotObject + ggplot2::annotation_logticks(base = exp(1), sides = "b", color = private$.font$color), plotObject ) - ) + }) return(plotObject) } ) @@ -379,15 +396,33 @@ YAxisConfiguration <- R6::R6Class( oob = .removeInfiniteValues ) ) - # Add special tick lines for pretty log plots - suppressMessages( + if(!isIncluded(private$.scale, c(Scaling$log, Scaling$ln))){ + return(plotObject) + } + # Checks that the final plot limits include at least one pretty log tick + plotScaleData <- ggplot2::layer_scales(plotObject) + yDataRange <- switch( + private$.scale, + "log" = 10^plotScaleData$y$range$range, + "ln" = exp(plotScaleData$y$range$range) + ) + if(!isEmpty(private$.limits)){ + yDataRange <- private$.limits + } + + if(!.isLogTicksIncludedInLimits(yDataRange, private$.scale)){ + return(plotObject) + } + suppressMessages({ plotObject <- switch(private$.scale, "log" = plotObject + ggplot2::annotation_logticks(sides = "l", color = private$.font$color), "ln" = plotObject + ggplot2::annotation_logticks(base = exp(1), sides = "l", color = private$.font$color), plotObject ) - ) + }) return(plotObject) } ) ) + + diff --git a/man/dot-isLogTicksIncludedInLimits.Rd b/man/dot-isLogTicksIncludedInLimits.Rd new file mode 100644 index 00000000..d712c106 --- /dev/null +++ b/man/dot-isLogTicksIncludedInLimits.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/error-checks.R +\name{.isLogTicksIncludedInLimits} +\alias{.isLogTicksIncludedInLimits} +\title{Check that at least one log tick is included in limits} +\usage{ +.isLogTicksIncludedInLimits(limits, scale) +} +\arguments{ +\item{limits}{An array of numeric values} + +\item{scale}{Name of log scale: \code{Scaling$log} for log10 scale, \code{Scaling$ln} for logarithmic scale} +} +\description{ +Check that at least one log tick is included in limits +} +\keyword{internal} diff --git a/man/isBetween.Rd b/man/isBetween.Rd new file mode 100644 index 00000000..c2f70d44 --- /dev/null +++ b/man/isBetween.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/helpers.R +\name{isBetween} +\alias{isBetween} +\title{isBetween} +\usage{ +isBetween(x, left, right, strict = FALSE) +} +\arguments{ +\item{x}{Numeric values to assess} + +\item{left}{Numeric value(s) used as lower bound} + +\item{right}{Numeric value(s) used as upper bound} + +\item{strict}{Logical value defining if \code{x} is strictly between \code{left} and \code{right}. +Default value is \code{FALSE}.} +} +\value{ +Logical values +} +\description{ +Assess if \code{x} is between \code{left} and \code{right} bounds. +Shortcut for \code{x >= left & x <= right} if \code{strict=FALSE} (default). +Shortcut for \code{x > left & x < right} if \code{strict=TRUE}. +} +\examples{ +isBetween(1:12, 7, 9) + +x <- rnorm(1e2) +x[isBetween(x, -1, 1)] + +isBetween(x, cos(x) + 1, cos(x) - 1) +} diff --git a/tests/testthat/test-axes.R b/tests/testthat/test-axes.R new file mode 100644 index 00000000..3bdbc253 --- /dev/null +++ b/tests/testthat/test-axes.R @@ -0,0 +1,31 @@ +isLogTicksIncludedInLimits <- tlf:::.isLogTicksIncludedInLimits + +test_that("isLogTicksIncludedInLimits checks work as expected", { + expect_true(isLogTicksIncludedInLimits(limits = 1, scale = Scaling$log)) + expect_true(isLogTicksIncludedInLimits(limits = 1, scale = Scaling$ln)) + expect_true(isLogTicksIncludedInLimits(limits = 10, scale = Scaling$log)) + expect_true(isLogTicksIncludedInLimits(limits = exp(1), scale = Scaling$ln)) + + expect_true(isLogTicksIncludedInLimits(limits = c(5, 15), scale = Scaling$log)) + expect_true(isLogTicksIncludedInLimits(limits = c(5, 15), scale = Scaling$ln)) + + expect_false(isLogTicksIncludedInLimits(limits = c(32, 33), scale = Scaling$log)) + expect_false(isLogTicksIncludedInLimits(limits = c(32, 33), scale = Scaling$ln)) + +}) + + +test_that("A plot with log ticks do not crash when isLogTicksIncludedInLimits is false", { + testPlot <- addScatter(x=c(31,32),y=c(31,32)) + expect_silent(print(setXAxis(testPlot, scale = Scaling$log))) + expect_silent(print(setYAxis(testPlot, scale = Scaling$log))) + expect_silent(print(setXAxis(testPlot, scale = Scaling$ln))) + expect_silent(print(setYAxis(testPlot, scale = Scaling$ln))) + + # If a classical plot is used, an error would be obtained as in the example below + # testPlot <- ggplot( + # data.frame(x=c(31,32),y=c(31,32)), + # aes(x=x,y=y)) + + # geom_point() + scale_y_log10() + annotation_logticks() + # expect_error(print(testPlot)) +})