Floating point comparison with zero

Question

I'm writing a function to calculate the quantile of the GEV distribution. The relevant aspect for this question is that a different form of the function is required when one of the parameters (the shape parameter or kappa) is zero

Programmatically, this is commonly addressed as follows (this is a snippet from evd:qgev and is similar in lmomco::quagev):

(Edit: Version 2.2.2 of lmomco has addressed the issue identified in this question)

if (shape == 0) 
        return(loc - scale * log(-log(p)))
    else return(loc + scale * ((-log(p))^(-shape) - 1)/shape)

This works fine if shape/kappa is exactly equal to zero but there is odd behaviour near zero.

Lets look at an example:

Qgev_zero <- function(shape){
  # p is an exceedance probability
  p= 0.01
  location=0
  scale=1

  if(shape == 0) return( location - scale*(log(-log(1-p) )))

  location + (scale/shape)*((-log(1-p))^-shape - 1)

}

Qgev_zero(0)
#[1] 4.600149

Qgev_zero(1e-8)
#[1] 4.600149  

This looks fine because the same answer is returned near zero and at zero. But look at what happens closer to zero.

k.seq <- seq(from =  -4e-16, to =  4e-16, length.out = 1000)
plot(k.seq, sapply(k.seq, Qgev_zero), type = 'l')

The value returned by the function oscillates is often incorrect.

These problems go away if I replace the direct comparison with zero with all.equal eg

if(isTRUE(all.equal(shape, 0))) return( location - scale*(log(-log(1-p) )))

Looking at the help for all.equal suggests that for default values, anything smaller than 1.5e-8 will be treated as zero.

Of course this odd behaviour near zero is probably not generally an issue but in my case, I'm using optimisation/root finding to determine parameters from known quantiles so am concerned that my code needs to be robust.

To the question: is using all.equal(target, 0) an appropriate way to deal with this problem? Why is it that this approach isn't used routinely?

Answer 1

Some functions, when implemented the obvious way with floating point representations, are ill-behaved at certain points. That's especially likely to be the case when the function has to be manually defined at a single point: When things go absolutely undefined at a point, it's likely that they're hanging on for dear life when they get close.

In this case, that's from the kappa denominator fighting the kappa negative exponent. Which one wins the battle is determined on a bit-by-bit basis, each one sometimes winning the "rounding to a stronger magnitude" contest.

There's a variety of approaches to fixing these sorts of problems, all of them designed on a case-by-case basis. One often-flawed but easy-to-implement approach is to switch to a better-behaved representation (say, the Taylor expansion with respect to kappa) near the problematic point. That'll introduce discontinuities at the boundaries; if necessary, you can try interpolating between the two.

Answer 2

Following Sneftel's suggestion, I calculate the quantile at k = -1e-7 and k = 1e-7 and interpolate if k argument falls between these limits. This seems to work.

In this code I'm using the parameterisation for the gev quantile function from lmomco::quagev

(Edit: Version 2.2.2 of lmomco has addressed the issues identified in this question)

The function Qgev is the problematic version (black line on plot), while Qgev_interp, interpolates near zero (green line on plot).

Qgev <- function(K, f, XI, A){ 

# K = shape
# f = probability
# XI = location
# A = scale

  Y <- -log(-log(f))
  Y <- (1-exp(-K*Y))/K
  x <- XI + A*Y
  return(x)
}

Qgev_interp <- function(K, f, XI, A){

  .F <- function(K, f, XI, A){
    Y <- -log(-log(f))
    Y <- (1-exp(-K*Y))/K
    x <- XI + A*Y
    return(x)
  }


  k1 <- -1e-7
  k2 <- 1e-7
  y1 <- .F(k1, f, XI, A)
  y2 <- .F(k2, f, XI, A)

  F_nearZero <- approxfun(c(k1, k2), c(y1, y2))

  if(K > k1 & K < k2) {
    return(F_nearZero(K))
  } else {
    return(.F(K, f, XI, A))
  }
}



k.seq <- seq(from =  -1.1e-7, to =  1.1e-7, length.out = 1000)
plot(k.seq, sapply(k.seq, Qgev, f = 0.01, XI = 0, A = 1), col=1, lwd = 1, type = 'l')
lines(k.seq, sapply(k.seq, Qgev_interp, f = 0.01, XI = 0, A = 1), col=3, lwd = 2)