Support digits="pdg" (#59)

Apply the Particle Data Group rounding rule

R/print.R

@@ -5,19 +5,27 @@
 #' @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.
 #' @param scientific logical specifying whether the elements should be
 #' encoded in scientific format.
 #' @param notation error notation; \code{"parenthesis"} and \code{"plus-minus"}
 #' are supported through the \code{"errors.notation"} option.
 #' @param ... ignored.
 #'
+#' @references
+#' K. Nakamura et al. (Particle Data Group), J. Phys. G 37, 075021 (2010)
+#'
 #' @examples
 #' x <- set_errors(1:3*100, 1:3*100 * 0.05)
 #' format(x)
 #' format(x, digits=2)
 #' format(x, scientific=TRUE)
 #' format(x, notation="plus-minus")
 #'
+#' x <- set_errors(c(0.827, 0.827), c(0.119, 0.367))
+#' format(x, notation="plus-minus", digits="pdg")
+#'
 #' @export
 format.errors = function(x,
                          digits = NULL,
@@ -32,9 +40,12 @@ format.errors = function(x,
   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)
-  value_digits <- ifelse(e, digits - get_exponent(e), getOption("digits"))
+  value_digits <- ifelse(e, digits - get_exponent(e), digits)
   value <- ifelse(e, signif(.v(x), exponent + value_digits), .v(x))
 
   cond <- (scientific | (exponent > 4+scipen | exponent < -3-scipen)) & is.finite(e)
@@ -61,7 +72,13 @@ format.errors = function(x,
       formatC(value[[i]], format="f", digits=max(0, value_digits[[i]]-1), decimal.mark=getOption("OutDec"))
     else format(value[[i]])
   })
-  e <- formatC(e, format="fg", flag="#", digits=digits, width=digits, 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="")
 }

R/utils.R

@@ -26,6 +26,15 @@ warn_once_coercion <- function(fun) warn_once(
 
 get_exponent <- function(x) ifelse(.v(x), floor(log10(abs(.v(x)))), 0)
 
+digits_pdg <- function(x) {
+  # extract 3 highest order digits
+  x <- ifelse(is.finite(x), x, 0)
+  x_sci <- formatC(abs(x), digits=2, format="e", decimal.mark=".")
+  x_hod <- as.integer(gsub("(\\.|e.*)", "", x_sci))
+
+  ifelse(x_hod < 355, 2, ifelse(x_hod < 950, 1, 0))
+}
+
 propagate <- function(xx, x, y, dx, dy, method=getOption("errors.propagation", "taylor-first-order")) {
   # if y not defined, use a vector of NAs
   if (length(y) == 1 && is.na(y))

tests/testthat/test-print.R

@@ -17,6 +17,9 @@ test_that("error formatting works properly", {
   expect_equal(format(x, notation="parenthesis", digits=3),
                c("10000(12300000)", "11110(1230)", "11111.2(123)", "11111.22(123)",
                  "11111.222(123)", "11111.2222(123)", "11111.2222200(123)", "11111.2222200000(123)"))
+  expect_equal(format(x, notation="parenthesis", digits="pdg"),
+               c("10000(12000000)", "11100(1200)", "11111(12)", "11111.2(12)",
+                 "11111.22(12)", "11111.222(12)", "11111.222220(12)", "11111.222220000(12)"))
   expect_equal(format(x, notation="parenthesis", scientific=TRUE),
                c("1(1000)e4", "1.1(1)e4", "1.111(1)e4", "1.1111(1)e4", "1.11112(1)e4",
                  "1.111122(1)e4", "1.111122222(1)e4", "1.111122222000(1)e4"))
@@ -29,12 +32,21 @@ test_that("error formatting works properly", {
     c("10000", "12300000"), c("11110", "1230"), c("11111.2", "12.3"), c("11111.22", "1.23"),
     c("11111.222", "0.123"), c("11111.2222", "0.0123"), c("11111.2222200", "0.0000123"), c("11111.2222200000", "0.0000000123")),
     paste, collapse=paste("", .pm, "")))
+  expect_equal(format(x, notation="plus-minus", digits="pdg"), sapply(list(
+    c("10000", "12000000"), c("11100", "1200"), c("11111", "12"), c("11111.2", "1.2"),
+    c("11111.22", "0.12"), c("11111.222", "0.012"), c("11111.222220", "0.000012"), c("11111.222220000", "0.000000012")),
+    paste, collapse=paste("", .pm, "")))
   expect_equal(format(x, notation="plus-minus", scientific=TRUE), sapply(list(
     c("(1", "1000)e4"), c("(1.1", "0.1)e4"), c("(1.111", "0.001)e4"), c("(1.1111", "0.0001)e4"),
     c("(1.11112", "0.00001)e4"), c("(1.111122", "0.000001)e4"), c("(1.111122222", "0.000000001)e4"),
     c("(1.111122222000", "0.000000000001)e4")),
     paste, collapse=paste("", .pm, "")))
 
+  x <- set_errors(rep(0.827, 3), c(0.119, 0.367, 0.962))
+  expect_equal(format(x, notation="plus-minus", digits="pdg"), sapply(list(
+    c("0.83", "0.12"), c("0.8", "0.4"), c("1", "1")),
+    paste, collapse=paste("", .pm, "")))
+
   x <- set_errors(10, 1)
   expect_equal(format(x - set_errors(10)), "0(1)")
   expect_equal(format(x - x), "0(0)")