Fixes Open-Systems-Pharmacology#381 Prevent log ticks from crashing p…

…lots (Open-Systems-Pharmacology#382)

NAMESPACE

@@ -126,6 +126,7 @@ export(getSameLimits)
 export(getSqrtTickLabels)
 export(getSymmetricLimits)
 export(initializePlot)
+export(isBetween)
 export(loadThemeFromJson)
 export(plotBoxWhisker)
 export(plotCumulativeTimeProfile)

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)
+}

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

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)
     }
   )
 )
+
+

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))
+})