From d0904ff808139996d6476b444c18dc31eab16bd5 Mon Sep 17 00:00:00 2001 From: David C Hall Date: Sat, 27 Jul 2024 17:33:11 -0500 Subject: [PATCH] Support digits="pdg" Apply the Particle Data Group rounding rule --- R/print.R | 21 +++++++++++++++++++-- R/utils.R | 9 +++++++++ man/format.errors.Rd | 10 +++++++++- tests/testthat/test-print.R | 12 ++++++++++++ 4 files changed, 49 insertions(+), 3 deletions(-) diff --git a/R/print.R b/R/print.R index 70a9319..79c421d 100644 --- a/R/print.R +++ b/R/print.R @@ -5,12 +5,17 @@ #' @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) @@ -18,6 +23,9 @@ #' 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="") } diff --git a/R/utils.R b/R/utils.R index ad72711..b62e22a 100644 --- a/R/utils.R +++ b/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)) diff --git a/man/format.errors.Rd b/man/format.errors.Rd index 1f0190a..81f2f11 100644 --- a/man/format.errors.Rd +++ b/man/format.errors.Rd @@ -11,7 +11,9 @@ \item{x}{an \code{errors} object.} \item{digits}{how many significant digits are to be used for uncertainties. -The default, \code{NULL}, uses \code{getOption("errors.digits", 1)}.} +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.} \item{scientific}{logical specifying whether the elements should be encoded in scientific format.} @@ -31,4 +33,10 @@ 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") + +} +\references{ +K. Nakamura et al. (Particle Data Group), J. Phys. G 37, 075021 (2010) } diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 627d1ba..06476d1 100644 --- a/tests/testthat/test-print.R +++ b/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)")