Skip to content

Commit

Permalink
Merge pull request #26 from SchlossLab/close-enough
Browse files Browse the repository at this point in the history
Check whether two numeric vectors are close_enough()
  • Loading branch information
jmoltzau committed Oct 25, 2021
2 parents 8e7d8cd + 7d96e40 commit 6730c0d
Show file tree
Hide file tree
Showing 5 changed files with 54 additions and 25 deletions.
15 changes: 0 additions & 15 deletions R/rmd_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -43,21 +43,6 @@ paste_oxford_list <- function(x) {
return(prose)
}

#' Checks whether a number is near to a whole number
#'
#' @param x a numeric
#'
#' @return `TRUE` or `FALSE`
#' @export
#'
#' @examples
#' is_nearly_whole(.Machine$double.eps^0.5)
#' is_nearly_whole(.Machine$double.eps^0.6)
#' is_nearly_whole(1)
is_nearly_whole <- function(x) {
abs(x - round(x)) < .Machine$double.eps^0.5
}

#' Format human-readable numbers.
#'
#' Pastes formatted `x` if numeric, otherwise `x` unmodified.
Expand Down
37 changes: 37 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
@@ -1,3 +1,40 @@
#' Checks whether a number is near to a whole number
#'
#' @param x a numeric
#'
#' @return `TRUE` or `FALSE`
#' @export
#' @author Kelly Sovacool \email{sovacool@@umich.edu}
#'
#' @examples
#' is_nearly_whole(.Machine$double.eps^0.5)
#' is_nearly_whole(.Machine$double.eps^0.6)
#' is_nearly_whole(1)
is_nearly_whole <- function(x) {
abs(x - round(x)) < .Machine$double.eps^0.5
}

#' Check whether two numeric vectors are close enough for gov't work.
#'
#' This is like `dplyr::near()` except with much less precision.
#'
#' @param x a numeric vector
#' @param y another numeric vector
#' @param tol tolerance (default: `10^-3`.)
#'
#' @return `TRUE` if all numbers are near enough within the tolerance, otherwise `FALSE`
#' @export
#' @author Kelly Sovacool \email{sovacool@@umich.edu}
#'
#' @examples
#'
#' close_enough(0.0004, 0)
#' close_enough(0.8887, 0.8884)
#' close_enough(1, 2)
close_enough <- function(x, y, tol = 10^-3) {
all(dplyr::near(x, y, tol = tol))
}

#' Install & load packages
#' @param ... package names to install & load
#' @export
Expand Down
2 changes: 1 addition & 1 deletion docs/pkgdown.yml
Original file line number Diff line number Diff line change
Expand Up @@ -3,5 +3,5 @@ pkgdown: 1.6.1
pkgdown_sha: ~
articles:
introduction: introduction.html
last_built: 2021-10-25T17:27Z
last_built: 2021-10-25T18:09Z

9 changes: 0 additions & 9 deletions tests/testthat/test-rmd_helpers.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,15 +5,6 @@ test_that("paste_oxford_list() works for vectors & lists", {
expect_equal(paste_oxford_list(1), "1")
})

test_that("is_nearly_whole() works", {
expect_true(is_nearly_whole(.Machine$double.eps))
expect_true(is_nearly_whole(0))
expect_true(is_nearly_whole(1))
expect_false(is_nearly_whole(.Machine$double.eps^0.5))
expect_false(is_nearly_whole(2100.05))
expect_equal(is_nearly_whole(NA), NA)
})

test_that("format_number() works for numbers & strings", {
expect_equal(format_number(0.02), "0.02")
expect_equal(format_number(.Machine$double.eps^0.5), "0.000000015")
Expand Down
16 changes: 16 additions & 0 deletions tests/testthat/test-utils.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@

test_that("is_nearly_whole() works", {
expect_true(is_nearly_whole(.Machine$double.eps))
expect_true(is_nearly_whole(0))
expect_true(is_nearly_whole(1))
expect_false(is_nearly_whole(.Machine$double.eps^0.5))
expect_false(is_nearly_whole(2100.05))
expect_equal(is_nearly_whole(NA), NA)
})

test_that("close_enough() works", {
expect_true(close_enough(0.0004, 0))
expect_true(close_enough(0.8887, 0.8884))
expect_false(close_enough(1, 2))
expect_equal(close_enough(1, NA), NA)
})

0 comments on commit 6730c0d

Please sign in to comment.