Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Accurate floating point comparisons with fpCompare #18

Merged
merged 4 commits into from
Oct 3, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,7 +1,7 @@
Package: intrval
Type: Package
Title: Relational Operators for Intervals
Version: 0.1-3
Version: 1.0-0
Date: 2024-05-19
Author: Peter Solymos [cre, aut] (<https://orcid.org/0000-0001-7337-1740>)
Maintainer: Peter Solymos <[email protected]>
Expand All @@ -11,6 +11,7 @@ Description: Evaluating if values
intervals overlap (`c(a1, b1) %[]o[]% c(a2, b2)`).
Operators for negation and directional relations also implemented.
License: GPL-2
Imports: fpCompare
URL: https://github.com/psolymos/intrval
BugReports: https://github.com/psolymos/intrval/issues
LazyLoad: yes
Expand Down
5 changes: 4 additions & 1 deletion NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,9 @@ export(
"%()o[]%", "%()o[)%", "%()o(]%", "%()o()%",
"%ni%", "%nin%", "%notin%",
"%[c]%", "%[c)%", "%(c]%", "%(c)%",
"intrval_types")
"intrval_types",
"intrval_options")

importFrom("graphics", "lines", "par", "plot", "points", "text")
# importFrom("fpCompare", "%>=%", "%>>%", "%<=%", "%<<%", "%==%", "%!=%")

10 changes: 10 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,13 @@
# Version 1.0-0 -- Sep 21, 2024

* Fixing floating point number comparisons (#17).
* Added global package options via `intrval_options()`.
* The `"use_fpCompare"` option controls the use of fpCompare for
numeric-to-numeric comparisons, default is `TRUE`;
this is potentially a breaking change, use
`intrval_options(use_fpCompare = FALSE)` for the mostly undesirable
base R behavior.

# Version 0.1-3 -- May 19, 2024

* Maintainer email changed to personal.
Expand Down
80 changes: 62 additions & 18 deletions R/intrnals.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,15 +27,15 @@ function(x, interval, type)
type_b <- substr(type, 2L, 2L)
ab <- .get_intrval(interval)
A <- switch(type_a,
"[" = x >= ab$a,
"]" = x <= ab$a,
"(" = x > ab$a,
")" = x < ab$a)
"[" = x %>=% ab$a,
"]" = x %<=% ab$a,
"(" = x %>>% ab$a,
")" = x %<<% ab$a)
B <- switch(type_b,
"[" = x >= ab$b,
"]" = x <= ab$b,
"(" = x > ab$b,
")" = x < ab$b)
"[" = x %>=% ab$b,
"]" = x %<=% ab$b,
"(" = x %>>% ab$b,
")" = x %<<% ab$b)
list(A=A, B=B)
}

Expand All @@ -53,17 +53,17 @@ function(x, interval, type)
{
ab <- .get_intrval(interval)
switch(match.arg(type, c("[", "(")),
"[" = x < ab$a,
"(" = x <= ab$a)
"[" = x %<<% ab$a,
"(" = x %<=% ab$a)
}

.greatrthan <-
function(x, interval, type)
{
ab <- .get_intrval(interval)
switch(match.arg(type, c("]", ")")),
"]" = x > ab$b,
")" = x >= ab$b)
"]" = x %>>% ab$b,
")" = x %>=% ab$b)
}

## a1 %[]% c(a2, b2) | b1 %[]% c(a2, b2)
Expand Down Expand Up @@ -103,14 +103,14 @@ function(interval1, interval2, type1, type2)
type1 <- match.arg(type1, c("[]", "[)", "(]", "()"))
type2 <- match.arg(type2, c("[]", "[)", "(]", "()"))

b1 <- ifelse(iv1$a < iv2$a, iv1$b, iv2$b)
a2 <- ifelse(iv1$a < iv2$a, iv2$a, iv1$a)
type1v <- ifelse(iv1$a < iv2$a, substr(type1, 2L, 2L), substr(type2, 2L, 2L))
type2v <- ifelse(iv1$a < iv2$a, substr(type2, 1L, 1L), substr(type1, 1L, 1L))
b1 <- ifelse(iv1$a %<<% iv2$a, iv1$b, iv2$b)
a2 <- ifelse(iv1$a %<<% iv2$a, iv2$a, iv1$a)
type1v <- ifelse(iv1$a %<<% iv2$a, substr(type1, 2L, 2L), substr(type2, 2L, 2L))
type2v <- ifelse(iv1$a %<<% iv2$a, substr(type2, 1L, 1L), substr(type1, 1L, 1L))

ifelse(type1v == "]" & type2v == "[",
b1 >= a2,
b1 > a2)
b1 %>=% a2,
b1 %>>% a2)
}

## cut the number line into 3 intervals: -Inf, a, b, +Inf
Expand All @@ -124,3 +124,47 @@ function(x, interval, type)
out[i$A & !i$B] <- +1L
out
}

## fpCompare functions
# "%>=%" <- fpCompare::`%>=%`
# "%>>%" <- fpCompare::`%>>%`
# "%<=%" <- fpCompare::`%<=%`
# "%<<%" <- fpCompare::`%<<%`
# "%==%" <- fpCompare::`%==%`
# "%!=%" <- fpCompare::`%!=%`

# "%>=%" <- base::`>=`
# "%>>%" <- base::`>`
# "%<=%" <- base::`<=`
# "%<<%" <- base::`<`
# "%==%" <- base::`==`
# "%!=%" <- base::`!=`

.use_fpc <- function() {
isTRUE(getOption("intrval_options")$use_fpCompare[[1L]])
}

"%>=%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%>=%`(e1, e2) else base::`>=`(e1, e2)
}
"%>>%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%>>%`(e1, e2) else base::`>`(e1, e2)
}
"%<=%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%<=%`(e1, e2) else base::`<=`(e1, e2)
}
"%<<%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%<<%`(e1, e2) else base::`<`(e1, e2)
}
"%==%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%==%`(e1, e2) else base::`==`(e1, e2)
}
"%!=%" <- function(e1, e2) {
if (.use_fpc() && is.numeric(e1) && is.numeric(e2))
fpCompare::`%!=%`(e1, e2) else base::`!=`(e1, e2)
}
33 changes: 33 additions & 0 deletions R/zzz.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
.options_set <- FALSE

.onLoad <- function(libname, pkgname) {
if (is.null(getOption("intrval_options"))) {
.options_set <<- TRUE
options("intrval_options" = list(
use_fpCompare = TRUE
))
}
invisible(NULL)
}

.onUnload <- function(libpath) {
if (.options_set) {
options("intrval_options" = NULL)
}
invisible(NULL)
}

intrval_options <- function(...) {
opar <- getOption("intrval_options")
args <- list(...)
if (length(args)) {
if (length(args) == 1L && is.list(args[[1L]])) {
npar <- args[[1L]]
} else {
npar <- opar
npar[match(names(args), names(npar))] <- args
}
options("intrval_options" = npar)
}
invisible(opar)
}
29 changes: 28 additions & 1 deletion README.md
Original file line number Diff line number Diff line change
Expand Up @@ -272,6 +272,34 @@ dt1 %[]o()% dt2
# [1] 0 4 4 0 0
```

### Floating point number comparisons

The intrval package used [fpCompare](https://CRAN.R-project.org/package=fpCompare)
to reliable numeric-to-numeric comparisons. The behavior can be turned off
to use the less reliable base R implementation:

```R
x1 <- 0.5 - 0.3
x2 <- 0.3 - 0.1

op <- intrval_options(use_fpCompare = FALSE)

## this is the base R behavior
x1 %[]% c(0.2, 0.6)
# [1] TRUE
x2 %[]% c(0.2, 0.6)
# [1] FALSE

## reset defaults
intrval_options(op)

## using fpCompare
x1 %[]% c(0.2, 0.6)
# [1] TRUE
x2 %[]% c(0.2, 0.6)
# [1] TRUE
```

### Truncated distributions

![](https://github.com/psolymos/intrval/raw/master/extras/dtrunc.png)
Expand All @@ -298,7 +326,6 @@ curve(dtrunc(x, distr="norm", lwr=-1, upr=1), add=TRUE, col=2, n=n)

### Shiny example 1: regular slider


![](https://github.com/psolymos/intrval/raw/master/extras/regular_slider.gif)

```R
Expand Down
43 changes: 43 additions & 0 deletions man/opts.Rd
Original file line number Diff line number Diff line change
@@ -0,0 +1,43 @@
\name{intrval-options}
\alias{intrval-options}
\alias{intrval_options}
\title{Global options for the intrval package}
\usage{
intrval_options(...)
}
\arguments{
\item{...}{Options to set.}
}
\value{
When parameters are set by \code{intrval_options}, their former values are
returned in an invisible named list. Such a list can be passed as an
argument to \code{intrval_options} to restore the parameter values.
Tags are the following:
\itemize{
\item \code{use_fpCompare}: use the fpCompare package for the reliable comparison of floating point numbers.
}
}
\description{
Options store and allow to set global values for the intrval functions.
}
\examples{
str(intrval_options())

x1 <- 0.5 - 0.3
x2 <- 0.3 - 0.1

# save old values and set the new one
op <- intrval_options(use_fpCompare = FALSE)

# this is the base R behavior
x1 %[]% c(0.2, 0.6) # TRUE
x2 %[]% c(0.2, 0.6) # FALSE

# reset defaults
intrval_options(op)

# using fpCompare
x1 %[]% c(0.2, 0.6) # TRUE
x2 %[]% c(0.2, 0.6) # TRUE

}
1 change: 1 addition & 0 deletions tests/tests.R
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#devtools::install_github("psolymos/intrval")

library(intrval)
library(fpCompare)

## run examples with \dontrun sections

Expand Down
Loading