Constant ylim susceptible to numerical precision issues

Replace strict `==` with `all.equal()` and move the check into a function defined in the plot object. Use constant ylim for multi.panel with different y-axis ylim. The main panel ylim are recalculated using the range of all columns, even when `multi.panel = TRUE` and only one column is plotted on the panel. Closes #368. Co-authored-by: Joshua Ulrich <josh.m.ulrich@gmail.com>
joshuaulrich · Jun 13, 2022 · 96612b7 · 96612b7
1 parent 62aa765
commit 96612b7
Show file tree

Hide file tree

Showing 2 changed files with 39 additions and 21 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Package: xts
 Type: Package
 Title: eXtensible Time Series
-Version: 0.12.1.2
+Version: 0.12.1.3
 Authors@R: c(
   person(given=c("Jeffrey","A."), family="Ryan", role=c("aut","cph")),
   person(given=c("Joshua","M."), family="Ulrich", role=c("cre","aut"), email="josh.m.ulrich@gmail.com"),

diff --git a/R/plot.R b/R/plot.R
@@ -290,32 +290,30 @@ plot.xts <- function(x,
   cs$Env$main <- main
   cs$Env$ylab <- if (hasArg("ylab")) eval.parent(plot.call$ylab) else ""
 
-  # chart_Series uses fixed=FALSE and add_* uses fixed=TRUE, not sure why or
-  # which is best.
   if(is.null(ylim)){
     if(isTRUE(multi.panel)){
       if(yaxis.same){
         # set the ylim for the first panel based on all the data
-        yrange <- range(cs$Env$xdata[subset], na.rm=TRUE)
+        yrange <- cs$create_ylim(cs$Env$xdata[subset,])
+        # and recalculate ylim when drawing (fixed=FALSE)
+        cs$set_ylim(list(structure(yrange, fixed=FALSE)))
       } else {
         # set the ylim for the first panel based on the first column
-        yrange <- range(cs$Env$xdata[,1][subset], na.rm=TRUE)
+        yrange <- cs$create_ylim(cs$Env$xdata[subset, 1])
+        # but do NOT recalculate ylim when drawing (fixed=TRUE)
+        cs$set_ylim(list(structure(yrange, fixed=TRUE)))
       }
     } else {
       # set the ylim based on all the data if this is not a multi.panel plot
-      yrange <- range(cs$Env$xdata[subset], na.rm=TRUE)
+      yrange <- cs$create_ylim(cs$Env$xdata[subset,])
+      # and recalculate ylim when drawing (fixed=FALSE)
+      cs$set_ylim(list(structure(yrange, fixed=FALSE)))
     }
-    if(yrange[1L] == yrange[2L]) {
-      if(yrange[1L] == 0) {
-        yrange <- yrange + c(-1, 1)
-      } else {
-        yrange <- c(0.8, 1.2) * yrange[1L]
-      }
-    }
-    cs$set_ylim(list(structure(yrange, fixed=FALSE)))
+
     cs$Env$constant_ylim <- range(cs$Env$xdata[subset], na.rm=TRUE)
   } else {
     # use the ylim arg passed in
+    # but do NOT recalculate ylim when drawing (fixed=TRUE)
     cs$set_ylim(list(structure(ylim, fixed=TRUE)))
     cs$Env$constant_ylim <- ylim
   }
@@ -420,7 +418,7 @@ plot.xts <- function(x,
     if(yaxis.same){
       lenv$ylim <- cs$Env$constant_ylim
     } else {
-      lenv$ylim <- range(cs$Env$xdata[subset,1], na.rm=TRUE)
+      lenv$ylim <- cs$create_ylim(cs$Env$xdata[subset, 1])
     }
 
     exp <- quote(chart.lines(xdata,
@@ -452,9 +450,7 @@ plot.xts <- function(x,
         if(yaxis.same){
           lenv$ylim <- cs$Env$constant_ylim
         } else {
-          yrange <- range(cs$Env$xdata[subset,i], na.rm=TRUE)
-          if(all(yrange == 0)) yrange <- yrange + c(-1,1)
-          lenv$ylim <- yrange
+          lenv$ylim <- cs$create_ylim(cs$Env$xdata[subset, i])
         }
         lenv$type <- cs$Env$type
 
@@ -1095,6 +1091,25 @@ new.replot_xts <- function(frame=1,asp=1,xlim=c(1,10),ylim=list(structure(c(1,10
   get_xlim  <- function(xlim) { Env$xlim }
   get_ylim  <- function(ylim) { Env$ylim }
 
+  create_ylim <-
+  function(x, const_y_mult = 0.2)
+  {
+    # Create y-axis limits from 'x'. Jitter the max/min limits by
+    # 'const_y_mult' if the max/min values are the same.
+    lim <- range(x, na.rm = TRUE)
+
+    if(isTRUE(all.equal(lim[1L], lim[2L]))) {
+      # if max and min are the same
+      if(lim[1L] == 0) {
+        lim <- c(-1, 1)
+      } else {
+        lim <- lim[1L] * c(1 - const_y_mult, 1 + const_y_mult)
+      }
+    }
+
+    return(lim)
+  }
+
   # scale ylim based on current frame, and asp values
   scale_ranges <- function(frame, asp, ranges)
   {
@@ -1187,6 +1202,7 @@ new.replot_xts <- function(frame=1,asp=1,xlim=c(1,10),ylim=list(structure(c(1,10
     ylim <- get_ylim()
     for(y in seq(from_by,length(ylim),by=from_by)) {
       if(!attr(ylim[[y]],'fixed'))
+        # if fixed=FALSE set ylim to +/-Inf so update_frame() recalculates ylim
         ylim[[y]] <- structure(c(Inf,-Inf),fixed=FALSE)
     }
     update_frame <- function(x)
@@ -1203,7 +1219,7 @@ new.replot_xts <- function(frame=1,asp=1,xlim=c(1,10),ylim=list(structure(c(1,10
         lenv_data <- lenv$xdata
         if(!is.null(lenv_data)) {
           # some actions (e.g. addLegend) do not have 'xdata'
-          dat.range <- range(na.omit(lenv$xdata[Env$xsubset]))
+          dat.range <- create_ylim(lenv$xdata[Env$xsubset])
           min.tmp <- min(ylim[[frame]][1],dat.range,na.rm=TRUE)
           max.tmp <- max(ylim[[frame]][2],dat.range,na.rm=TRUE)
           ylim[[frame]] <<- structure(c(min.tmp,max.tmp),fixed=fixed)
@@ -1352,15 +1368,17 @@ new.replot_xts <- function(frame=1,asp=1,xlim=c(1,10),ylim=list(structure(c(1,10
   replot_env$reset_ylim <- reset_ylim
   replot_env$set_ylim <- set_ylim
   replot_env$get_ylim <- get_ylim
+  replot_env$create_ylim <- create_ylim
   replot_env$set_pad <- set_pad
   replot_env$add_call <- add_call
 
   replot_env$new_environment <- function() { new.env(TRUE, Env) }
 
   # function to plot the y-axis grid lines
   replot_env$Env$y_grid_lines <- function(ylim) {
-    p <- pretty(ylim,5)
-    p[p > ylim[1] & p < ylim[2]]
+    p <- pretty(ylim, 5)
+    p <- p[p >= ylim[1] & p <= ylim[2]]
+    return(p)
   }
 
   # function to plot the x-axis grid lines