some refactoring, redoc, update NEWS, bump version

Author: Enchufa2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: errors
 Type: Package
 Title: Uncertainty Propagation for R Vectors
-Version: 0.4.1
+Version: 0.4.2
 Authors@R: c(
     person("Iñaki", "Ucar", email="[email protected]",
       role=c("aut", "cph", "cre"), comment=c(ORCID="0000-0001-6403-5550")),
@@ -20,6 +20,6 @@ LazyData: true
 Depends: R (>= 3.0.0)
 Suggests: dplyr (>= 1.0.0), vctrs (>= 0.5.0), pillar, ggplot2 (>= 3.4.0),
     testthat, vdiffr, knitr, rmarkdown
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(old_usage = TRUE)
 VignetteBuilder: knitr

NEWS.md

@@ -1,3 +1,7 @@
+# errors 0.4.2
+
+- Add support for PDG rounding rules (@davidchall #59 addressing #45).
+
 # errors 0.4.1
 
 - Switch from `size` (deprecated in `ggplot2` v3.4.0) to `linewidth` aesthetic

R/errors.R

@@ -34,7 +34,6 @@
 #' Measurement Errors in \R. \emph{The R Journal}, 10(2), 549-557.
 #' \doi{10.32614/RJ-2018-075}
 #'
-#' @docType package
 #' @import stats
 #' @name errors-package
 #'
@@ -77,7 +76,7 @@
 #' # Predicted correction for 30 degC
 #' (b.30 <- y1 + y2 * set_errors(30 - 20))
 #'
-NULL
+"_PACKAGE"
 
 #' Handle Uncertainty on a Numeric Vector
 #'

R/print.R

@@ -5,8 +5,8 @@
 #' @param x an \code{errors} object.
 #' @param digits how many significant digits are to be used for uncertainties.
 #' The default, \code{NULL}, uses \code{getOption("errors.digits", 1)}.
-#' Use `digits="pdg"` to choose an appropriate number of digits for each value
-#' according to the Particle Data Group rounding rule.
+#' Use \code{digits="pdg"} to choose an appropriate number of digits for each
+#' value according to the Particle Data Group rounding rule (see references).
 #' @param scientific logical specifying whether the elements should be
 #' encoded in scientific format.
 #' @param notation error notation; \code{"parenthesis"} and \code{"plus-minus"}
@@ -34,25 +34,28 @@ format.errors = function(x,
                          ...)
 {
   stopifnot(notation %in% c("parenthesis", "plus-minus"))
+
   if (is.null(digits))
-    digits = getOption("errors.digits", 1)
+    digits <- getOption("errors.digits", 1)
+  digits <- if (digits == "pdg") digits_pdg(.e(x)) else rep(digits, length(x))
+
   scipen <- getOption("scipen", 0)
   prepend <- rep("", length(x))
   append <- rep("", length(x))
 
-  if (digits == "pdg")
-    digits <- digits_pdg(.e(x))
-
   e <- signif(.e(x), digits)
-  exponent <- get_exponent(x)
+  nulle <- e == 0 & !is.na(e)
+  xexp <- get_exponent(x)
   value_digits <- ifelse(e, digits - get_exponent(e), digits)
-  value <- ifelse(e, signif(.v(x), exponent + value_digits), .v(x))
+  value <- ifelse(e, signif(.v(x), xexp + value_digits), .v(x))
+  value <- ifelse(is.finite(value), value, .v(x))
 
-  cond <- (scientific | (exponent > 4+scipen | exponent < -3-scipen)) & is.finite(e)
-  e[cond] <- e[cond] * 10^(-exponent[cond])
-  value[cond] <- value[cond] * 10^(-exponent[cond])
-  value_digits[cond] <- digits - get_exponent(e)[cond]
-  value_digits[is.infinite(value_digits)] <- 0
+  cond <- (scientific | (xexp > 4+scipen | xexp < -3-scipen)) & is.finite(e)
+  e[cond] <- e[cond] * 10^(-xexp[cond])
+  value[cond] <- value[cond] * 10^(-xexp[cond])
+  value_digits[cond] <- digits[cond] - get_exponent(e)[cond]
+  value_digits[!is.finite(value_digits)] <- 0
+  value_digits[nulle] <- getOption("digits", 7)
 
   if (notation == "parenthesis") {
     sep <- "("
@@ -63,23 +66,22 @@ format.errors = function(x,
     prepend[cond] <- "("
     append[cond] <- ")"
   }
-  append[cond] <- paste(append[cond], "e", exponent[cond], sep="")
+  append[cond] <- paste(append[cond], "e", xexp[cond], sep="")
 
   value <- sapply(seq_along(value), function(i) {
-    if (!is.finite(e[[i]]))
-      format(.v(x)[[i]])
-    else if (e[[i]])
-      formatC(value[[i]], format="f", digits=max(0, value_digits[[i]]-1), decimal.mark=getOption("OutDec"))
-    else format(value[[i]])
+    formatC(value[[i]], format="f",
+            digits=max(0, value_digits[[i]]-1),
+            decimal.mark=getOption("OutDec"))
+  })
+  value[nulle] <- prettyNum(value[nulle], drop0trailing=TRUE)
+
+  e <- sapply(seq_along(digits), function(i) {
+    formatC(e[[i]], format="fg", flag="#",
+            digits=digits[[i]], width=max(1, digits[[i]]),
+            decimal.mark=getOption("OutDec"))
   })
-  e <- if (length(unique(digits)) > 1)  {
-    sapply(seq_along(digits), function(i) {
-      formatC(e[[i]], format="fg", flag="#", digits=digits[[i]], width=max(1, digits[[i]]), decimal.mark=getOption("OutDec"))
-    })
-  } else {
-    formatC(e, format="fg", flag="#", digits=digits[[1]], width=max(1, digits[[1]]), decimal.mark=getOption("OutDec"))
-  }
   e <- sub("\\.$", "", e)
+
   paste(prepend, value, sep, e, append, sep="")
 }
 

man/format.errors.Rd

@@ -51,9 +51,10 @@ test_that("error formatting works properly", {
   expect_equal(format(x - set_errors(10)), "0(1)")
   expect_equal(format(x - x), "0(0)")
 
-  x <- set_errors(c(0.4, NA, NaN, Inf))
+  x <- set_errors(c(0.4, NA, NaN, Inf, -Inf))
   expect_equal(format(x[1]), "0.4(0)")
   expect_equal(format(x[2]), "NA(NA)")
   expect_equal(format(x[3]), "NaN(NaN)")
   expect_equal(format(x[4]), "Inf(Inf)")
+  expect_equal(format(x[5]), "-Inf(Inf)")
 })